Guide local repairs for Jerboa atom aliases
ober
b66355da5335b812f7fe72253dd5a4a8e612472c
--- a/src/jcode/core/verified-run.ss +++ b/src/jcode/core/verified-run.ss @@ -1031,6 +1031,8 @@ '(("qt-timer-on-timeout!" . "qt-on-timeout!") ("qt-app-exit!" . "qt-app-quit!") ("qt-widget-grab-to-png!" . "qt-widget-screenshot!") + ("atom-set!" . "atom-reset!") + ("atom-val" . "atom-deref") ("Qt::Key_Left" . "16777234") ("Qt::Key_Up" . "16777235") ("Qt::Key_Right" . "16777236") @@ -1043,6 +1045,18 @@ (let ((hit (assoc symbol qt-api-symbol-aliases))) (and hit (cdr hit)))) +(def (replace-all content old-str new-str) + (let loop ((start 0) (out "")) + (let ((idx (find-substring-from content old-str start))) + (if idx + (loop (+ idx (string-length old-str)) + (string-append + out + (substring content start idx) + new-str)) + (string-append out + (substring content start (string-length content))))))) + (def (unbound-symbol-replacement symbol) (or (defstruct-setter-name symbol) (qt-inherited-widget-name symbol) @@ -1080,7 +1094,7 @@ (line-no (line-number-at-index content index)) (line (line-at (string-split content #\newline) line-no)) (candidate (and line - (replace-first line symbol replacement)))) + (replace-all line symbol replacement)))) (and candidate (make-required-range-repair path line-no line-no line-no @@ -1793,6 +1807,14 @@ "handlers inside the same `let*` that binds `canvas`, pass `canvas` as " "an argument to the helper, or initialize a top-level `current-canvas` " "before callbacks can run.")) + ((or (string=? symbol "atom-set!") + (string=? symbol "atom-val")) + (string-append + "\nJerboa atom API hint: `atom-set!` and `atom-val` are guessed names, " + "not Jerboa exports. Use `(atom-reset! a value)` to set an atom and " + "`(atom-deref a)` or `(deref a)` to read one. Replace the exact " + "unbound name in the writable source, then call verify; do not inspect " + "module exports before this edit.")) (else ""))) (def (unbound-symbol-source-guidance detail cwd) --- a/test/run.ss +++ b/test/run.ss @@ -3544,6 +3544,10 @@ [initial (string-append "(import (jerboa prelude))\n" + "(def first-atom (atom 0))\n" + "(def second-atom (atom 0))\n" + "(atom-set! first-atom 1) (atom-set! second-atom 2)\n" + "(display (atom-val first-atom))\n" "(defstruct state (next-type))\n" "(set-state-next-type! first 1)\n" "(set-state-next-type! second 2)\n" @@ -3555,7 +3559,11 @@ (list (make-wtool-call "verify" '() #f))))] [verify-command (string-append - "if grep -q set-state-next-type " target + "if grep -q 'atom-set!' " target + "; then echo 'Exception: variable atom-set! is not bound'; exit 1; " + "elif grep -q 'atom-val' " target + "; then echo 'Exception: variable atom-val is not bound'; exit 1; " + "elif grep -q set-state-next-type " target "; then echo 'Exception: variable set-state-next-type! is not bound'; exit 1; " "elif grep -q qt-paint-widget-set-minimum-size " target "; then echo 'Exception: variable qt-paint-widget-set-minimum-size! is not bound'; exit 1; fi")]) @@ -3569,7 +3577,7 @@ (cons 'verify-command verify-command) (cons 'write-scope (parse-write-scope target)) (cons 'local-model? #t) - (cons 'max-iterations 8) + (cons 'max-iterations 12) (cons 'max-tool-errors 3) (cons 'on-message (lambda (m) @@ -3588,13 +3596,28 @@ (str-contains? (car rest) "state-next-type-set!")) (loop (cdr rest))))))) + (check-pred! "verified-run: unbound atom diagnosis supplies Jerboa atom API" + (reverse tool-results) + (lambda (xs) + (let loop ([rest xs]) + (and (pair? rest) + (or (and (str-contains? (car rest) + "Jerboa atom API hint") + (str-contains? (car rest) "atom-reset!") + (str-contains? (car rest) "atom-deref")) + (loop (cdr rest))))))) (check-pred! "verified-run: unbound setter candidates repair all occurrences" (call-with-input-file target-path (lambda (p) (get-string-all p))) (lambda (s) - (and (str-contains? s "(state-next-type-set! first 1)") + (and (str-contains? s "(atom-reset! first-atom 1)") + (str-contains? s "(atom-reset! second-atom 2)") + (str-contains? s "(display (atom-deref first-atom))") + (str-contains? s "(state-next-type-set! first 1)") (str-contains? s "(state-next-type-set! second 2)") (str-contains? s "(qt-widget-set-minimum-size! canvas 10 20)") + (not (str-contains? s "atom-set!")) + (not (str-contains? s "atom-val")) (not (str-contains? s "set-state-next-type!"))))) (safe-delete-test-file! target-path))