Repair quoted with-qt-app verifier failures
ober
f9bb660dde1c1c3519a4ae8a513eb8787959126f
--- a/src/jcode/core/verified-run.ss +++ b/src/jcode/core/verified-run.ss @@ -1444,9 +1444,102 @@ (string-append (string-join patched-lines "\n") ")"))) - (and (balance-ok-text? - (balance-report candidate label)) - candidate)))))) + (and (balance-ok-text? + (balance-report candidate label)) + candidate)))))) + +(def (last-substring-index-before text needle limit) + (let loop ((start 0) (best #f)) + (let ((idx (find-substring-from text needle start))) + (cond + ((not idx) best) + ((>= idx limit) best) + (else (loop (+ idx 1) idx)))))) + +(def (qt-with-app-form-start-before-line content line-no) + (let* ((line-start (line-start-index-at content line-no)) + (line-end (and line-start + (line-end-index-from content line-start)))) + (and line-end + (last-substring-index-before content "(with-qt-app" line-end)))) + +(def (qt-quoted-with-app-candidate form label) + (and (string-contains form "(with-qt-app") + (or (string-contains form "(with-qt-app '(") + (string-contains form "(with-qt-app (quote ")) + (let ((lambda-index (string-contains form "(lambda ()"))) + (and lambda-index + (let* ((first-line-end (line-end-index-from form 0)) + (first-line (substring form 0 first-line-end)) + (indent (line-leading-space first-line)) + (lambda-line-end + (line-end-index-from form lambda-index)) + (body-start + (if (< lambda-line-end (string-length form)) + (+ lambda-line-end 1) + (+ lambda-index (string-length "(lambda ()")))) + (body-end (- (string-length form) 2))) + (and (> body-end body-start) + (string-suffix? "))" form) + (let ((candidate + (string-append + indent "(with-qt-app app\n" + (substring form body-start body-end) + ")"))) + (and (balance-ok-text? + (balance-report candidate label)) + candidate)))))))) + +(def (qt-quoted-with-app-repair detail cwd) + (and (string-contains detail "invalid bound variable") + (or (string-contains detail "(quote (") + (string-contains detail "(quote ")) + (let* ((diag-start + (or (find-diagnostic-start detail + (list "invalid bound variable")) + 0)) + (line-no + (find-line-number-after-from detail " at line " diag-start))) + (and line-no + (let ((path (verification-source-path cwd detail line-no diag-start))) + (and path + (let ((p (abs-path cwd path))) + (and (file-exists? p) + (let* ((content (read-file-string p)) + (start-index + (qt-with-app-form-start-before-line + content line-no)) + (end-index + (and start-index + (form-end-index content start-index))) + (start-line + (and start-index + (line-number-at-index + content start-index))) + (end-line + (and end-index + (line-number-at-index + content + (max start-index + (- end-index 1))))) + (form + (and end-index + (substring + content start-index end-index))) + (label + (and start-line end-line + (format "~a lines ~a-~a" + path start-line end-line))) + (candidate + (and form label + (<= start-line line-no) + (<= line-no end-line) + (qt-quoted-with-app-candidate + form label)))) + (and candidate + (make-required-range-repair + path start-line end-line line-no + 'qt-lifecycle candidate))))))))))) (def (qt-invalid-bound-with-app-repair detail cwd) (and (string-contains detail "invalid bound variable") @@ -1499,7 +1592,8 @@ 'qt-lifecycle candidate))))))))))) (def (qt-lifecycle-repair detail cwd) - (or (qt-invalid-bound-with-app-repair detail cwd) + (or (qt-quoted-with-app-repair detail cwd) + (qt-invalid-bound-with-app-repair detail cwd) (and (string-contains detail "missing with-qt-app") (or (string-contains detail "self-test timed out") (string-contains detail "self-test command failed") @@ -1829,10 +1923,10 @@ (source-target-lines lines path "qt-app-exec!" 4)) (destroy-lines (source-target-lines lines path "qt-app-destroy!" 4))) - (string-append - "\n\nQt self-test lifecycle diagnosis: jcode identified the complete `run-self-test` definition and constructed a syntax-checked repair. It wraps only self-test Qt setup as `(with-qt-app app body ...)`, avoids `qt-app-exec!`, and removes manual quit/destroy calls. Apply the exact candidate to the diagnosed `run-self-test` span and verify immediately; do not edit `run-game` or inspect Qt libraries first.\nLifecycle source targets:\n" - (string-join - (append create-lines exec-lines destroy-lines) + (string-append + "\n\nQt self-test lifecycle diagnosis: jcode identified the diagnosed Qt lifecycle span and constructed a syntax-checked repair. It uses `(with-qt-app app body ...)`, avoids `qt-app-exec!` in self-test paths, and removes manual quit/destroy calls when present. Apply the exact candidate to the diagnosed span and verify immediately; do not inspect Qt libraries first.\nLifecycle source targets:\n" + (string-join + (append create-lines exec-lines destroy-lines) "\n") (best-repair-candidate-text cwd repair (required-repair-label repair))))))) @@ -2708,7 +2802,7 @@ (string-append "inspection limit reached after failed verify while calling " (symbol->string who) - ". Stop inspecting and call line_edit, replace_range, replace_def, or edit with the concrete repair now." + ". Stop inspecting. Do not call read, list, shell, bash, run, or MCP discovery again for this verifier failure; those calls are hidden/refused and waste repair turns. Call line_edit, replace_range, replace_def, or edit with the concrete repair now, then verify." (let ((detail (current-last-verify-detail))) (if detail (string-append "\n\nLast verify failure:\n" (tail-lines detail 20)) --- a/test/run.ss +++ b/test/run.ss @@ -3236,9 +3236,9 @@ (not (str-contains? s "qt-app-quit!"))))) (safe-delete-test-file! target-path)) - (let* ([vr-dir "/tmp"] - [target "jcode-local-qt-invalid-bound-with-app-auto-repair.ss"] - [target-path (string-append vr-dir "/" target)] + (let* ([vr-dir "/tmp"] + [target "jcode-local-qt-invalid-bound-with-app-auto-repair.ss"] + [target-path (string-append vr-dir "/" target)] [initial (string-append "(import (jerboa prelude))\n" @@ -3278,12 +3278,63 @@ (call-with-input-file target-path (lambda (p) (get-string-all p))) (lambda (s) (and (str-contains? s "(with-qt-app app") - (str-contains? s "(main '())") - (not (str-contains? s "(with-qt-app (lambda () #t))"))))) - (safe-delete-test-file! target-path)) + (str-contains? s "(main '())") + (not (str-contains? s "(with-qt-app (lambda () #t))"))))) + (safe-delete-test-file! target-path)) - (let* ([vr-dir "/tmp"] - [target "jcode-local-self-test-command-line-auto-repair.ss"] + (let* ([vr-dir "/tmp"] + [target "jcode-local-qt-quoted-with-app-auto-repair.ss"] + [target-path (string-append vr-dir "/" target)] + [initial + (string-append + "(import (jerboa prelude))\n" + "(def self-test-mode #t)\n" + "(if self-test-mode\n" + " (with-qt-app '(\"Tetris Self-Test\" \"-platform\" \"offscreen\")\n" + " (lambda ()\n" + " (display \"ok\")\n" + " (qt-pump-events! app)))\n" + " (display \"interactive\"))\n")] + [responder + (scripted-responder + (list (list (make-wtool-call "verify" '() #f))))] + [verify-command + (string-append + "if grep -q \"(with-qt-app '(\" " target + "; then echo 'Exception: invalid bound variable (quote (\"Tetris Self-Test\" \"-platform\" \"offscreen\")) in broken form at line 4, char 5 of " + target-path + "'; exit 2; fi; " + "grep -q '(with-qt-app app' " target + " || { echo 'FAIL: repair missing with-qt-app app'; exit 1; }; " + "grep -q '(lambda ()' " target + " && { echo 'FAIL: repair kept lambda wrapper'; exit 1; }; " + "grep -q 'qt-pump-events! app' " target + " || { echo 'FAIL: repair lost app body'; exit 1; }")]) + (safe-delete-test-file! target-path) + (call-with-output-file target-path + (lambda (p) (display initial p)) 'replace) + (let ([result + (verified-run responder "repair quoted with-qt-app use" + (list + (cons 'cwd vr-dir) + (cons 'verify-command verify-command) + (cons 'write-scope (parse-write-scope target)) + (cons 'local-model? #t) + (cons 'max-iterations 6) + (cons 'max-tool-errors 2)))]) + (check! "verified-run: quoted with-qt-app auto repair verifies" + result "VERIFIED: exit 0\n")) + (check-pred! "verified-run: quoted with-qt-app repair unwraps lambda" + (call-with-input-file target-path (lambda (p) (get-string-all p))) + (lambda (s) + (and (str-contains? s "(with-qt-app app") + (str-contains? s "(qt-pump-events! app)") + (not (str-contains? s "(with-qt-app '(\"Tetris Self-Test\"")) + (not (str-contains? s "(lambda ()"))))) + (safe-delete-test-file! target-path)) + + (let* ([vr-dir "/tmp"] + [target "jcode-local-self-test-command-line-auto-repair.ss"] [target-path (string-append vr-dir "/" target)] [initial (string-append