Fix verified write-scope all handling
ober
31d93dafd04d82b3bbc0666b0c28bf049c377eb2
--- a/src/jcode/core/verified-run.ss +++ b/src/jcode/core/verified-run.ss @@ -34,6 +34,13 @@ (def (opt-get o key) (let ((p (assoc key o))) (and p (cdr p)))) +(def (normalize-write-scope-option raw) + (cond + ((not raw) #f) + ((eq? raw 'none) 'none) + ((list? raw) raw) + (else (parse-write-scope raw)))) + (def (hash-args . kvs) (let ((h (make-hash-table))) (let loop ((xs kvs)) @@ -3392,7 +3399,15 @@ (current-successful-edit-count 0) (current-pre-edit-mcp-count 0) (let* ((o (if (pair? opt) (car opt) '())) - (scope (or (opt-get o 'write-scope) (current-write-scope))) + (scope-pair (assoc 'write-scope o)) + (scope (if scope-pair + (normalize-write-scope-option (cdr scope-pair)) + (current-write-scope))) + (scoped-tool + (lambda (fn) + (lambda (args) + (parameterize ((current-write-scope scope)) + (fn args))))) (run-aliases? (let ((p (assoc 'run-aliases? o))) (if p (cdr p) #f))) (external-tools? (let ((p (assoc 'external-tools? o))) @@ -3411,73 +3426,74 @@ '()))) (let ((read-def (make-tool-def - (make-tool-spec "read" - "Read a file's current contents. args: {\"path\": string, optional \"line\"/\"start\" and \"end\" line numbers, or \"offset\"/\"limit\"}." - *obj-schema*) - (lambda (args) (do-read args cwd)) '())) + (make-tool-spec "read" + "Read a file's current contents. args: {\"path\": string, optional \"line\"/\"start\" and \"end\" line numbers, or \"offset\"/\"limit\"}." + *obj-schema*) + (scoped-tool (lambda (args) (do-read args cwd))) '())) (list-def (make-tool-def (make-tool-spec "list" "List a directory under the verified working directory. args: {\"path\": string, optional; default \".\"}. Read-only." *obj-schema*) - (lambda (args) (do-list args cwd)) '())) + (scoped-tool (lambda (args) (do-list args cwd))) '())) (ls-def (make-tool-def (make-tool-spec "ls" "Alias for list. args: {\"path\": string, optional; default \".\"}. Read-only." *obj-schema*) - (lambda (args) (do-list args cwd)) '())) + (scoped-tool (lambda (args) (do-list args cwd))) '())) (cat-def (make-tool-def (make-tool-spec "cat" "Alias for read. args: {\"path\": string}." *obj-schema*) - (lambda (args) (do-read args cwd)) '())) + (scoped-tool (lambda (args) (do-read args cwd))) '())) (tail-def (make-tool-def (make-tool-spec "tail" "Return the last lines of a file. args: {\"path\": string, \"lines\": number optional}. \"file\" is accepted as a path alias." *obj-schema*) - (lambda (args) + (scoped-tool (lambda (args) (let ((path (arg-path args #f))) (if path (read-lines-at path cwd 'tail (line-tool-count args 50)) - "tail: missing path"))) + "tail: missing path")))) '())) (head-def (make-tool-def (make-tool-spec "head" "Return the first lines of a file. args: {\"path\": string, \"lines\": number optional}. \"file\" is accepted as a path alias." *obj-schema*) - (lambda (args) + (scoped-tool (lambda (args) (let ((path (arg-path args #f))) (if path (read-lines-at path cwd 'head (line-tool-count args 50)) - "head: missing path"))) + "head: missing path")))) '())) (wc-def (make-tool-def (make-tool-spec "wc" "Return a file line count. args: {\"path\": string}. \"file\" is accepted as a path alias." *obj-schema*) - (lambda (args) + (scoped-tool (lambda (args) (let ((path (arg-path args #f))) (if path (string-append (line-count-for path cwd) " " path) - "wc: missing path"))) + "wc: missing path")))) '())) (balance-def (make-tool-def (make-tool-spec "balance" "Check delimiter balance for a file and report unmatched paren/bracket/brace line and column. args: {\"path\": string}. Use after syntax errors such as unexpected close parenthesis." *obj-schema*) - (lambda (args) (balance-file args cwd)) '())) + (scoped-tool (lambda (args) (balance-file args cwd))) '())) (create-script-def (make-tool-def (make-tool-spec "create_verified_jerboa_script" "Create a small executable Jerboa .ss starter through the verified edit path. args: {\"path\": string ending .ss, \"kind\": \"minimal-pass\" | \"cli-two-args\" | \"vector-grid\"}. Use only when a generic template clearly matches: minimal-pass for trivial scripts, cli-two-args for simple numeric two-argument CLIs, vector-grid for 2-D vector/grid examples. For nontrivial algorithms, you may skip scaffolding and write a small complete first version, then verify and expand deterministically." *obj-schema*) - (lambda (args) (create-verified-jerboa-script args cwd)) + (scoped-tool + (lambda (args) (create-verified-jerboa-script args cwd))) '())) (run-def (make-tool-def @@ -3486,10 +3502,10 @@ "Safe alias for simple shell habits: supports ls/cat/head/tail/wc/grep/rg, plain file read, plain directory list, and mkdir -p PATH under write scope. Arbitrary shell is unavailable. Use verify for the configured build/test command." "Guidance-only disabled shell alias. Do not retry run. Use verify for the configured build/test command and edit/line_edit/replace_def/replace_range for repairs.") *obj-schema*) - (lambda (args) + (scoped-tool (lambda (args) (if run-aliases? (do-run-alias args cwd) - (shell-unavailable args))) + (shell-unavailable args)))) '())) (bash-def (make-tool-def @@ -3498,10 +3514,10 @@ "Safe alias for simple shell habits: supports ls/cat/head/tail/wc/grep/rg, plain file read, plain directory list, and mkdir -p PATH under write scope. Arbitrary shell is unavailable. Use verify for the configured build/test command." "Guidance-only disabled shell alias. Do not retry bash. Use verify for the configured build/test command and edit/line_edit/replace_def/replace_range for repairs.") *obj-schema*) - (lambda (args) + (scoped-tool (lambda (args) (if run-aliases? (do-run-alias args cwd) - (shell-unavailable args))) + (shell-unavailable args)))) '())) (shell-def (make-tool-def @@ -3510,29 +3526,29 @@ "Safe alias for simple shell habits: supports ls/cat/head/tail/wc/grep/rg, plain file read, plain directory list, and mkdir -p PATH under write scope. Arbitrary shell is unavailable. Use verify for the configured build/test command." "Guidance-only disabled shell alias. Do not retry shell. Use verify for the configured build/test command and edit/line_edit/replace_def/replace_range for repairs.") *obj-schema*) - (lambda (args) + (scoped-tool (lambda (args) (if run-aliases? (do-run-alias args cwd) - (shell-unavailable args))) + (shell-unavailable args)))) '())) (edit-def (make-tool-def (make-tool-spec "edit" "Edit a file. Full write args: {\"path\": string, \"content\": string}; \"file\", \"filename\", \"file_path\", \"filepath\", \"target\", and \"target_path\" are accepted as path aliases. \"file\" is still accepted as a content alias when a separate path is present. \"contents\", \"new_content\", \"body\", and \"text\" are accepted as content aliases. Exact replacement args: {\"path\": string, \"old_str\": string, \"new_str\": string}; old_string/new_string are accepted aliases; \"content\" may be used instead of \"new_str\" when \"old_str\" is present. Line replacement args: {\"path\": string, \"line\": number, \"content\": string}." *obj-schema*) - (lambda (args) (do-edit args cwd)) '())) + (scoped-tool (lambda (args) (do-edit args cwd))) '())) (write-def (make-tool-def (make-tool-spec "write" "Alias for edit. Full write args: {\"path\": string, \"content\": string}. Exact replacement accepts old_str/new_str or old_string/new_string. \"file\" is accepted as a path alias and content/file/body/text aliases are accepted like edit." *obj-schema*) - (lambda (args) (do-edit args cwd)) '())) + (scoped-tool (lambda (args) (do-edit args cwd))) '())) (line-edit-def (make-tool-def (make-tool-spec "line_edit" "Replace exactly one line in a file. args: {\"path\": string, \"line\": number, \"content\": string}. \"file\" is accepted as a path alias. Use this for compiler errors or verifier diagnostics with stable line numbers." *obj-schema*) - (lambda (args) + (scoped-tool (lambda (args) (let ((path (arg-path args #f)) (content (arg-content args)) (line-no (arg-int args "line" 0))) @@ -3546,21 +3562,21 @@ (list (cons "path" path) (cons "line" line-no) (cons "content" content)) - cwd))))) + cwd)))))) '())) (replace-def (make-tool-def (make-tool-spec "replace_def" "Replace a whole top-level function definition by name using delimiter matching. args: {\"path\": string, \"name\": string, \"content\": string}. Use this when a verifier error is inside one function and exact old_str replacement is brittle." *obj-schema*) - (lambda (args) (replace-definition args cwd)) + (scoped-tool (lambda (args) (replace-definition args cwd))) '())) (replace-range-def (make-tool-def (make-tool-spec "replace_range" "Replace an inclusive line range, even if the old code is unbalanced. args: {\"path\": string, \"start\": number, \"end\": number, \"content\": string}. Replacement aliases accepted: new_content, new_str, new_string, replacement, body, text. Path/start/end without content does nothing. Use this after balance/read/sed identifies a broken span and replace_def cannot parse it." *obj-schema*) - (lambda (args) (replace-range args cwd)) + (scoped-tool (lambda (args) (replace-range args cwd))) '())) (verify-def (make-tool-def @@ -3570,7 +3586,7 @@ "then call verify again.") *obj-schema*) (make-verify-callable - (lambda (args) + (scoped-tool (lambda (args) (let ((pending (or (rejected-draft-hard-recovery-message cwd 'verify) (pending-ss-create-repair-message cwd)))) @@ -3582,14 +3598,14 @@ (and (pair? result) (not (car result)) (verify-range-repair (cdr result) cwd))) - result)))))) + result))))))) '())) (done-def (make-tool-def (make-tool-spec "done" "Finish the task. Only call AFTER verify has passed. args: {\"summary\": string}." *obj-schema*) - (lambda (args) (arg-ref args "summary" "done")) + (scoped-tool (lambda (args) (arg-ref args "summary" "done"))) '()))) (make-workflow "verified-coding" @@ -3645,7 +3661,10 @@ (vcmd (or (opt-get o 'verify-command) default-verify-command)) (cwd (or (opt-get o 'cwd) ".")) (k (or (opt-get o 'best-of) 1)) - (scope (parse-write-scope (opt-get o 'write-scope))) + (scope-pair (assoc 'write-scope o)) + (scope (if scope-pair + (normalize-write-scope-option (cdr scope-pair)) + #f)) (task-guidance (combine-task-guidance (verified-preflight-guidance task cwd vcmd scope) --- a/test/run.ss +++ b/test/run.ss @@ -2085,6 +2085,31 @@ (safe-delete-test-file! allowed-path) (safe-delete-test-file! denied-path)) +(let* ([vr-dir "/tmp"] + [target "jcode-verified-scope-all.txt"] + [target-path (string-append vr-dir "/" target)] + [slurp (lambda (p) (call-with-input-file p (lambda (i) (get-string-all i))))]) + (safe-delete-test-file! target-path) + (let* ([wf (parameterize ((current-write-scope 'none)) + (coding-workflow (string-append "grep -q unrestricted " target) vr-dir + (list (cons 'write-scope #f) + (cons 'terminal-on-verify #t))))] + [resp (scripted-responder + (list + (list (make-wtool-call "edit" + (list (cons "path" target) + (cons "content" "unrestricted")) + #f)) + (list (make-wtool-call "verify" '() #f))))] + [result (parameterize ((current-write-scope 'none)) + (run-workflow wf "explicit all scope should write" resp + (list (cons 'max-iterations 6))))]) + (check! "verified-run: explicit all scope overrides ambient read-only" + result "VERIFIED: exit 0\n") + (check! "verified-run: explicit all scope wrote file" + (slurp target-path) "unrestricted")) + (safe-delete-test-file! target-path)) + (let* ([vr-dir "/tmp"] [target "jcode-verified-heredoc.txt"] [target-path (string-append vr-dir "/" target)]