Allow complete retry after rejected create
ober
5a2f1b7ce87f0921dd11baeffdd70878b058c87e
--- a/src/jcode/core/verified-run.ss +++ b/src/jcode/core/verified-run.ss @@ -5453,6 +5453,11 @@ path content "full-write snippets")) ((and (not (file-exists? p)) (source-ss-path? path) + (rejected-draft-content cwd path)) + (stage-or-promote-rejected-draft! + cwd path content 'edit "complete replacement")) + ((and (not (file-exists? p)) + (source-ss-path? path) (rejected-draft-inspection-required-message path)) => (lambda (msg) (raise-recoverable-tool-error msg 'edit))) --- a/test/run.ss +++ b/test/run.ss @@ -3021,19 +3021,22 @@ result "VERIFIED: exit 0\n") (check! "verified-run: fake provider wrote repaired file" (slurp target-path) good) - (check-pred! "verified-run: repeated broad create forces inspection first" + (check-pred! "verified-run: repeated broad create keeps staged repair path" (reverse tool-results) (lambda (xs) - (let loop ([ys xs] [saw-recoverable #f] [saw-block #f]) + (let loop ([ys xs] [saw-recoverable #f] [saw-staged #f] [saw-promote #f]) (cond - [(null? ys) (and saw-recoverable saw-block)] + [(null? ys) (and saw-recoverable saw-staged saw-promote)] [else (loop (cdr ys) (or saw-recoverable (str-contains? (car ys) "[ToolRecoverableError]")) - (or saw-block + (or saw-staged (str-contains? (car ys) - "blocked until the rejected draft is inspected")))]))))) + "staged result is still not valid Jerboa syntax")) + (or saw-promote + (str-contains? (car ys) + "complete replacement repaired and promoted rejected draft")))]))))) (safe-delete-test-file! target-path)) (let* ([vr-dir "/tmp"] @@ -8905,20 +8908,82 @@ result "rejected-draft-loop-ok") (check! "verified-run: repeated rejected creates write fixed file" (slurp target-path) good) - (check-pred! "verified-run: repeated rejected creates get loop guidance" + (check-pred! "verified-run: repeated rejected creates keep staged repair guidance" (reverse tool-results) (lambda (xs) (let loop ([ys xs]) (cond [(null? ys) #f] - [(and (str-contains? (car ys) "Multiple full-file writes") - (str-contains? (car ys) "Stop guessing") - (str-contains? (car ys) "balance(path=\"")) + [(and (str-contains? (car ys) "staged result is still not valid Jerboa syntax") + (str-contains? (car ys) "The staged draft remains editable") + (str-contains? (car ys) "Do not regenerate the full file")) #t] [else (loop (cdr ys))])))) (safe-delete-test-file! target-path))) (let* ([vr-dir "/tmp"] + [target "jcode-verified-rejected-draft-complete-retry.ss"] + [target-path (string-append vr-dir "/" target)] + [snippet "test"] + [bad "(import (jerboa prelude))\n(define (main)\n (displayln \"bad\")))\n"] + [good "(import (jerboa prelude))\n(define (main)\n (displayln \"fixed\"))\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 fixed " target) vr-dir + (list (cons 'write-scope scope) + (cons 'run-aliases? #t)))] + [resp (scripted-responder + (list + (list + (make-wtool-call + "edit" + (list (cons "path" target) + (cons "content" snippet)) + #f)) + (list + (make-wtool-call + "edit" + (list (cons "path" target) + (cons "content" bad)) + #f)) + (list + (make-wtool-call + "edit" + (list (cons "path" target) + (cons "content" good)) + #f)) + (list (make-wtool-call "verify" '() #f)) + (list (make-wtool-call "done" '(("summary" . "complete-retry-ok")) #f))))] + [result (parameterize ((current-write-scope scope)) + (run-workflow wf "retry missing ss create with complete full body" resp + (list (cons 'max-iterations 10) + (cons 'max-tool-errors 3) + (cons 'on-message + (lambda (m) + (when (equal? (message-role m) "tool") + (set! tool-results + (cons (message-content m) tool-results))))))))]) + (check! "verified-run: complete missing-file retry reaches verified done" + result "complete-retry-ok") + (check! "verified-run: complete missing-file retry writes final file" + (slurp target-path) good) + (check-pred! "verified-run: complete retry is not blocked for inspection" + (reverse tool-results) + (lambda (xs) + (let loop ([ys xs] [saw-promote #f]) + (cond + [(null? ys) saw-promote] + [(str-contains? (car ys) "blocked until the rejected draft is inspected") #f] + [else + (loop (cdr ys) + (or saw-promote + (str-contains? (car ys) + "complete replacement repaired and promoted rejected draft")))])))) + (safe-delete-test-file! target-path))) + + (let* ([vr-dir "/tmp"] [target "jcode-verified-rejected-draft-replace.ss"] [target-path (string-append vr-dir "/" target)] [bad "(import (jerboa prelude))\n(define (main)\n (displayln \"bad\")))\n"] @@ -9036,13 +9101,15 @@ result "rejected-draft-repeat-ok") (check! "verified-run: repeated rejected draft eventually writes fixed file" (slurp target-path) good) - (check-pred! "verified-run: identical rejected draft is called out" + (check-pred! "verified-run: identical rejected draft stays staged for repair" (reverse tool-results) (lambda (xs) (let loop ([ys xs]) (cond [(null? ys) #f] - [(str-contains? (car ys) "identical to the rejected draft") #t] + [(and (str-contains? (car ys) "staged result is still not valid Jerboa syntax") + (str-contains? (car ys) "The staged draft remains editable")) + #t] [else (loop (cdr ys))])))) (check-pred! "verified-run: identical rejected draft locks non-edit tools" (reverse tool-results)