Auto-repair unquoted Jerboa vector literals
ober
a20520207f1013af581df776969c1ab48014ee5c
--- a/src/jcode/core/verified-run.ss +++ b/src/jcode/core/verified-run.ss @@ -5487,6 +5487,62 @@ (else (loop (+ i 1) #f #f #f))))))))) +(def (replace-unquoted-vector-literals content) + (let ((n (string-length content))) + (let loop ((i 0) + (out '()) + (changed? #f) + (in-string? #f) + (escape? #f) + (in-comment? #f)) + (cond + ((>= i n) + (and changed? (list->string (reverse out)))) + (else + (let* ((ch (string-ref content i)) + (newline? (char=? ch #\newline))) + (cond + (in-comment? + (loop (+ i 1) (cons ch out) changed? #f #f + (and (not newline?) in-comment?))) + (in-string? + (cond + (escape? (loop (+ i 1) (cons ch out) changed? #t #f #f)) + ((char=? ch #\\) + (loop (+ i 1) (cons ch out) changed? #t #t #f)) + ((char=? ch #\") + (loop (+ i 1) (cons ch out) changed? #f #f #f)) + (else + (loop (+ i 1) (cons ch out) changed? #t #f #f)))) + ((char=? ch #\;) + (loop (+ i 1) (cons ch out) changed? #f #f #t)) + ((char=? ch #\") + (loop (+ i 1) (cons ch out) changed? #t #f #f)) + ((and (char=? ch #\') + (< (+ i 2) n) + (char=? (string-ref content (+ i 1)) #\#) + (char=? (string-ref content (+ i 2)) #\()) + (let ((after (skip-sharp-vector-datum content (+ i 1)))) + (if after + (let datum-loop ((j i) (out* out)) + (if (>= j after) + (loop after out* changed? #f #f #f) + (datum-loop (+ j 1) + (cons (string-ref content j) out*)))) + (loop (+ i 1) (cons ch out) changed? #f #f #f)))) + ((and (char=? ch #\#) + (< (+ i 1) n) + (char=? (string-ref content (+ i 1)) #\() + (or (= i 0) + (not (char=? (string-ref content (- i 1)) #\')))) + (let text-loop ((chars (string->list "(vector ")) + (out* out)) + (if (null? chars) + (loop (+ i 2) out* #t #f #f #f) + (text-loop (cdr chars) (cons (car chars) out*))))) + (else + (loop (+ i 1) (cons ch out) changed? #f #f #f))))))))) + (def (balance-ok-text? report) (string-prefix? "Balance OK:" report)) @@ -5537,9 +5593,12 @@ (or (apply-string-aliases after-qt-symbols qt-api-expression-aliases) after-qt-symbols)) + (after-vector-literals + (or (replace-unquoted-vector-literals after-expressions) + after-expressions)) (candidate - (and (not (string=? content after-expressions)) - after-expressions))) + (and (not (string=? content after-vector-literals)) + after-vector-literals))) (and candidate (not (string=? content candidate)) (not (jerboa-syntax-guard-message path candidate)) @@ -5570,6 +5629,7 @@ (string-contains original-content "qt-app-exit!") (string-contains original-content "qt-widget-grab-to-png!") (string-contains original-content "Qt::Key_") + (string-contains original-content "#(") (string-contains original-content "string->integer") (string-contains original-content "<<") (string-contains original-content ">>"))) --- a/test/run.ss +++ b/test/run.ss @@ -7090,12 +7090,6 @@ "(define (fallback-color type)\n" " (if type (vector 1 2 3 255) #(30 30 30 255)))\n" "(displayln \"ok\")\n")] - [good - (string-append - "(import (jerboa prelude))\n" - "(define (fallback-color type)\n" - " (if type (vector 1 2 3 255) (vector 30 30 30 255)))\n" - "(displayln \"ok\")\n")] [tool-results '()] [resp (scripted-responder @@ -7105,17 +7099,8 @@ (list (cons "path" target) (cons "content" bad)) #f)) - (list - (make-wtool-call "balance" - (list (cons "path" target)) - #f)) - (list - (make-wtool-call "write" - (list (cons "path" target) - (cons "content" good)) - #f)) (list (make-wtool-call "done" - '(("summary" . "inline-vector-literal-guard-ok")) + '(("summary" . "inline-vector-literal-auto-repair-ok")) #f))))]) (safe-delete-test-file! target-path) (let ([result @@ -7133,15 +7118,15 @@ (when (equal? (message-role m) "tool") (set! tool-results (cons (message-content m) tool-results)))))))]) - (check! "verified-run: inline vector literal guard recovers" + (check! "verified-run: inline vector literal auto repair verifies" result "VERIFIED: exit 0\n") - (check-pred! "verified-run: inline vector literal guard explains repair" + (check-pred! "verified-run: inline vector literal auto repair is reported" (reverse tool-results) (lambda (xs) (and (pair? xs) - (str-contains? (car xs) "unquoted vector literal syntax") - (str-contains? (car xs) "(vector ...)")))) - (check-pred! "verified-run: inline vector literal guard wrote repaired source" + (str-contains? (car xs) + "Jerboa compatibility alias repair")))) + (check-pred! "verified-run: inline vector literal auto repair wrote repaired source" (call-with-input-file target-path (lambda (p) (get-string-all p))) (lambda (s) (and (str-contains? s "(vector 30 30 30 255)")