Record atom accessor model guidance
ober
dd022e61430877b6d0f95f1ab2e6d0ed9565cf6a
--- a/data/anti-patterns.sexp +++ b/data/anti-patterns.sexp @@ -4612,4 +4612,24 @@ . "Do not broadly rewrite constants for vector-ref list errors") ("tools" "verify" "read" "line_edit" "replace_range" - "jerboa_error_fix_lookup"))) + "jerboa_error_fix_lookup")) + (("advice" + . + "Use the Jerboa atom API names already exported by the prelude: create with (atom initial), read with (atom-deref a) or (deref a), set with (atom-reset! a value) or (reset! a value), and update with atom-swap!/atom-update!/swap!. When verification says atom-set! or atom-val is unbound, replace all occurrences in the writable source and verify immediately.") + ("avoid" + . + "Do not use guessed Clojure-style or generic atom helper names such as atom-set! or atom-val in Jerboa code, and do not keep browsing exports after the verifier names one of these exact unbound symbols.") + ("id" . "invented-jerboa-atom-accessors") + ("kinds" "script" "debug-error" "test") + ("pattern" + . + "variable atom-(set!|val) is not bound|\\(atom-set!|\\(atom-val") + ("severity" . "medium") + ("tags" "atom" "atom-set" "atom-val" "unbound" "local-model" + "repair") + ("title" . "Do Not Invent Jerboa Atom Accessor Names") + ("tools" + "verify" + "line_edit" + "replace_range" + "jerboa_function_signature"))) --- a/data/error-fixes.sexp +++ b/data/error-fixes.sexp @@ -2846,4 +2846,18 @@ "A top-level helper cannot see a `canvas` that is local to a `with-qt-app`/`let*` setup block. Keep the callback helper in the same lexical scope as `canvas`, pass `canvas` as an argument, or initialize a top-level `current-canvas` before timer/key callbacks can run. Prefer a bounded edit to the helper/callback registration instead of broad rewrites.") ("id" . "qt-callback-local-canvas-unbound") ("pattern" . "Exception: variable canvas is not bound") - ("type" . "binding"))) + ("type" . "binding")) + (("code_example" + . + ";; Wrong\n(atom-set! state next)\n(atom-val state)\n\n;; Right\n(atom-reset! state next)\n(atom-deref state)") + ("explanation" + . + "Jerboa exports atom, atom-deref, atom-reset!, atom-swap!, atom-update!, deref, reset!, and swap! from the prelude. It does not export atom-set! or atom-val; those are plausible names from other Lisps but are unbound in Jerboa.") + ("fix" + . + "Replace guessed atom helpers with Jerboa atom API names: atom-set! -> atom-reset!, atom-val -> atom-deref or deref. Make the replacement in the writable source and verify immediately.") + ("id" . "jerboa-atom-accessor-unbound") + ("pattern" + . + "variable atom-(set!|val) is not bound|Exception: variable atom-(set!|val) is not bound") + ("type" . "module-api"))) new file mode 100644 --- /dev/null +++ b/tests/test-model-guidance-data.ss @@ -0,0 +1,66 @@ +#!chezscheme + +(import (scheme)) + +(define pass 0) +(define fail 0) + +(define (check name pred) + (if pred + (begin + (set! pass (+ pass 1)) + (printf " ok ~a~%" name)) + (begin + (set! fail (+ fail 1)) + (printf "FAIL ~a~%" name)))) + +(define (read-one path) + (call-with-input-file path + (lambda (in) + (read in)))) + +(define (entry-ref entry key) + (let ([hit (assoc key entry)]) + (and hit (cdr hit)))) + +(define (entry-by-id entries id) + (let loop ([xs entries]) + (cond + [(null? xs) #f] + [(equal? (entry-ref (car xs) "id") id) (car xs)] + [else (loop (cdr xs))]))) + +(define (string-contains? haystack needle) + (let ([hlen (string-length haystack)] + [nlen (string-length needle)]) + (let loop ([i 0]) + (cond + [(= nlen 0) #t] + [(> (+ i nlen) hlen) #f] + [(string=? (substring haystack i (+ i nlen)) needle) #t] + [else (loop (+ i 1))])))) + +(printf "--- model guidance data tests ---~%") + +(let* ([fixes (read-one "data/error-fixes.sexp")] + [fix (entry-by-id fixes "jerboa-atom-accessor-unbound")] + [anti-patterns (read-one "data/anti-patterns.sexp")] + [anti (entry-by-id anti-patterns "invented-jerboa-atom-accessors")]) + (check "atom unbound error fix exists" + (and fix + (string-contains? (entry-ref fix "pattern") "atom-") + (string-contains? (entry-ref fix "fix") "atom-reset!") + (string-contains? (entry-ref fix "fix") "atom-deref"))) + (check "invented atom accessor anti-pattern exists" + (and anti + (string-contains? (entry-ref anti "avoid") "atom-set!") + (string-contains? (entry-ref anti "avoid") "atom-val") + (string-contains? (entry-ref anti "advice") "verify immediately")))) + +(if (= fail 0) + (begin + (printf "OK: ~a checks, 0 failures~%" pass) + (exit 0)) + (begin + (printf "FAIL: ~a checks, ~a failures~%" (+ pass fail) fail) + (exit fail)))