Reject stub ss creates
ober
f40e3f5258da339e74542e49cf748573bf26c7d9
--- a/src/jcode/core/verified-run.ss +++ b/src/jcode/core/verified-run.ss @@ -4480,16 +4480,23 @@ (string-contains content "(let* ") (string-contains content "(display"))) +(def (ss-create-stub-marker-content? content) + (let ((s (string-downcase (or content "")))) + (or (string-contains s "placeholder") + (string-contains s "stub") + (string-contains s "todo")))) + (def (complete-ss-create-content? path content) (and (source-ss-path? path) (looks-like-complete-file? content) - (ss-create-has-substantive-form? content))) + (ss-create-has-substantive-form? content) + (not (ss-create-stub-marker-content? content)))) (def (incomplete-ss-create-repair-guidance path) (string-append "The content string itself must contain the actual implementation. " "Do not send placeholder comments or notes such as \"full content next\", " - "\"complete implementation below\", or \"placeholder\"; those are still incomplete. " + "\"complete implementation below\", \"placeholder\", \"stub\", or \"todo\"; those are still incomplete. " "Next call must put the complete source in the tool arguments, for example " "write(path=\"" path --- a/test/run.ss +++ b/test/run.ss @@ -9860,17 +9860,65 @@ (lambda (xs) (and (pair? xs) (str-contains? (car xs) "full-write snippets cannot create")))) - (check-pred! "verified-run: .ss full-write rejected snippet is readable" - (reverse tool-results) - (lambda (xs) - (let loop ([ys xs]) - (cond + (check-pred! "verified-run: .ss full-write rejected snippet is readable" + (reverse tool-results) + (lambda (xs) + (let loop ([ys xs]) + (cond [(null? ys) #f] - [(and (str-contains? (car ys) "Rejected draft") - (str-contains? (car ys) "(define (main)")) - #t] - [else (loop (cdr ys))]))))) - (safe-delete-test-file! target-path)) + [(and (str-contains? (car ys) "Rejected draft") + (str-contains? (car ys) "(define (main)")) + #t] + [else (loop (cdr ys))]))))) + (safe-delete-test-file! target-path)) + + (let* ([vr-dir "/tmp"] + [target "jcode-verified-stub-create-content.ss"] + [target-path (string-append vr-dir "/" target)] + [stub "(import (jerboa prelude))\n\n(define (main) (display \"stub\") (newline))\n(main)\n"] + [full "(import (jerboa prelude))\n(define (main) (display \"real\"))\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 real " 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 + "write" + (list (cons "path" target) + (cons "content" full)) + #f)) + (list (make-wtool-call "verify" '() #f)) + (list (make-wtool-call "done" '(("summary" . "stub-create-guard")) #f))))] + [result (parameterize ((current-write-scope scope)) + (run-workflow wf "reject stub ss create" resp + (list (cons 'max-iterations 8) + (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: .ss stub create recovers" + result "stub-create-guard") + (check! "verified-run: .ss stub retry writes full file" + (slurp target-path) full) + (check-pred! "verified-run: .ss stub create explains marker" + (reverse tool-results) + (lambda (xs) + (and (pair? xs) + (str-contains? (car xs) "[ToolRecoverableError]") + (str-contains? (car xs) "\"stub\""))))) + (safe-delete-test-file! target-path)) (let* ([vr-dir "/tmp"] [target "jcode-verified-syntax-guard-replace.ss"]