Reject incomplete staged ss creates
ober
6293c408976cdb2c81b77e2af144227a01a92633
--- a/src/jcode/core/verified-run.ss +++ b/src/jcode/core/verified-run.ss @@ -2752,6 +2752,12 @@ (current-pending-ss-create-repair #f) (reset-rejected-draft-state!)))) +(def (clear-pending-ss-create-draft-repair! cwd path) + (let ((pending (current-pending-ss-create-repair))) + (when (and pending + (same-verified-path? cwd pending path)) + (current-pending-ss-create-repair #f)))) + (def (absolute-path-string? path) (and (string? path) (> (string-length path) 0) @@ -4823,6 +4829,21 @@ msg) tool)) (begin + (when (and (not (file-exists? p)) + (source-ss-path? path) + (not (complete-ss-create-content? path content))) + (clear-pending-ss-create-draft-repair! cwd path) + (record-rejected-ss-draft! path content) + (raise-recoverable-tool-error + (string-append + action + " was applied to the retained rejected draft for " + path + ", but the staged result is still not a complete Jerboa .ss file. " + "A missing .ss target needs imports plus substantive implementation forms such as def, define, lambda, let, or display before it can be promoted. " + "The staged draft remains editable and was not written to disk. " + "Repair it with line_edit, replace_range, replace_def, exact old_str replacement, or send complete corrected contents, then call verify.") + tool)) (let ((dir (path-directory p))) (when (and dir (not (equal? dir "")) (not (file-exists? dir))) (mkdir-p dir))) --- a/test/run.ss +++ b/test/run.ss @@ -9629,6 +9629,68 @@ (safe-delete-test-file! target-path)) (let* ([vr-dir "/tmp"] + [target "jcode-verified-placeholder-staged-create.ss"] + [target-path (string-append vr-dir "/" target)] + [stub ";; placeholder\n(import (jerboa prelude))\n"] + [full "(import (jerboa prelude))\n(define (main) (displayln \"full\"))\n(main)\n"] + [tool-results '()] + [slurp (lambda (p) (call-with-input-file p (lambda (i) (get-string-all i))))]) + (safe-delete-test-file! target-path) + (let* ([scope (parse-write-scope target)] + [wf (coding-workflow (string-append "grep -q full " target) vr-dir + (list (cons 'write-scope scope)))] + [resp (scripted-responder + (list + (list + (make-wtool-call + "write" + (list (cons "path" target) + (cons "content" stub)) + #f)) + (list + (make-wtool-call + "edit" + (list (cons "path" target) + (cons "old_str" "placeholder") + (cons "new_str" "placeholder2")) + #f)) + (list + (make-wtool-call + "replace_range" + (list (cons "path" target) + (cons "start" 1) + (cons "end" 2) + (cons "content" full)) + #f)) + (list (make-wtool-call "verify" '() #f)) + (list (make-wtool-call "done" '(("summary" . "placeholder-staged-create-guard")) #f))))] + [result (parameterize ((current-write-scope scope)) + (run-workflow wf "reject placeholder staged ss create promotion" resp + (list (cons 'max-iterations 14) + (cons 'max-tool-errors 4) + (cons 'on-message + (lambda (m) + (when (equal? (message-role m) "tool") + (set! tool-results + (cons (message-content m) tool-results))))))))]) + (check! "verified-run: .ss placeholder staged create recovers" + result "placeholder-staged-create-guard") + (check! "verified-run: .ss placeholder staged create writes full file" + (slurp target-path) (string-append full "\n")) + (check-pred! "verified-run: .ss placeholder staged create blocks import-only promotion" + (reverse tool-results) + (lambda (xs) + (let loop ([ys xs]) + (cond + [(null? ys) #f] + [(and (str-contains? (car ys) "[ToolRecoverableError]") + (str-contains? (car ys) + "still not a complete Jerboa .ss file")) + #t] + [else (loop (cdr ys))]))))) + (safe-delete-test-file! target-path)) + + (let* ([vr-dir "/tmp"] [target "jcode-verified-snippet-create-content.ss"] [target-path (string-append vr-dir "/" target)] [snippet "(define (main) 1)\n"]