Apply first-edit pressure to incomplete drafts

ober

117055745d04abf9211e7152c7f88ce00e84016f

diff --git a/src/jcode/core/verified-run.ss b/src/jcode/core/verified-run.ss
index 12c2b0d..be295b0 100644
--- a/src/jcode/core/verified-run.ss
+++ b/src/jcode/core/verified-run.ss
@@ -208,10 +208,17 @@
            (>= (current-rejected-draft-path-reject-count)
                local-expert-after-rejected-drafts))))
 
+(def (incomplete-rejected-ss-create-draft?)
+  (let ((draft (current-rejected-ss-draft)))
+    (and (pair? draft)
+         (source-ss-path? (car draft))
+         (not (complete-ss-create-content? (car draft) (cdr draft))))))
+
 (def (local-focused-repair-mode?)
   (and (current-verified-local-model?)
        (or (current-after-failed-verify?)
            (and (current-rejected-ss-draft)
+                (not (incomplete-rejected-ss-create-draft?))
                 (> (current-rejected-draft-inspections) 0))
            (rejected-draft-staged-repair-mode?)
            (> (current-successful-edit-count) 0))))
@@ -299,7 +306,8 @@
           ;; Keep cheap directory navigation separate from source inspection,
           ;; so locating an approved dependency does not consume every read.
           ((and (= (current-successful-edit-count) 0)
-                (not (current-rejected-ss-draft))
+                (or (not (current-rejected-ss-draft))
+                    (incomplete-rejected-ss-create-draft?))
                 (not (current-pending-ss-create-repair))
                 (>= (pre-edit-inspection-total)
                     (if (current-verified-local-model?)
@@ -308,7 +316,8 @@
                 (verified-inspection-tool-spec? spec))
            #f)
           ((and (= (current-successful-edit-count) 0)
-                (not (current-rejected-ss-draft))
+                (or (not (current-rejected-ss-draft))
+                    (incomplete-rejected-ss-create-draft?))
                 (not (current-pending-ss-create-repair))
                 (or (and (verified-navigation-tool-spec? spec)
                          (>= (current-pre-edit-navigation-count)
@@ -405,7 +414,8 @@
   (and (= (current-successful-edit-count) 0)
        (not (current-edited-since-verify?))
        (not (current-after-failed-verify?))
-       (not (current-rejected-ss-draft))
+       (or (not (current-rejected-ss-draft))
+           (incomplete-rejected-ss-create-draft?))
        (not (current-pending-ss-create-repair))
        (if (current-verified-local-model?)
          (>= (pre-edit-inspection-total)
@@ -1751,7 +1761,8 @@
 
 (def (local-pre-edit-inspection-block-message tool-name)
   (and (= (current-successful-edit-count) 0)
-       (not (current-rejected-ss-draft))
+       (or (not (current-rejected-ss-draft))
+           (incomplete-rejected-ss-create-draft?))
        (not (current-pending-ss-create-repair))
        (let* ((navigation? (member tool-name '(list ls)))
               (next (+ (if navigation?
diff --git a/test/run.ss b/test/run.ss
index a7fafd0..59f03d6 100644
--- a/test/run.ss
+++ b/test/run.ss
@@ -7798,18 +7798,20 @@
 	               (string-append "grep -q fixed " target)
 	               vr-dir
 	               (list (cons 'write-scope scope)))]
-	         [result (parameterize ((current-write-scope scope))
-	                   (run-workflow wf "keep reads after incomplete missing create"
-	                     (provider-responder provider)
-	                     (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))))))))])
+	         [result (verified-run provider "keep reads after incomplete missing create"
+	                   (list (cons 'cwd vr-dir)
+	                         (cons 'verify-command
+	                               (string-append "grep -q fixed " target))
+	                         (cons 'write-scope scope)
+	                         (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: incomplete missing create schema reaches done"
-	            result "incomplete-create-schema-ok")
+	            result "VERIFIED: exit 0\n")
 	    (check-pred! "verified-run: incomplete create keeps inspection schemas"
 	      (reverse seen-specs)
 	      (lambda (xs)
@@ -7832,6 +7834,61 @@
 	            [else (loop (cdr ys))])))))
 	  (safe-delete-test-file! target-path))
 
+	(let* ([vr-dir "/tmp"]
+	       [target "jcode-verified-incomplete-create-pressure.ss"]
+	       [target-path (string-append vr-dir "/" target)]
+	       [snippet "x"]
+	       [full "(import (jerboa prelude))\n(define (main) (displayln \"fixed\"))\n(main)\n"]
+	       [forced-edit-specs? #f]
+	       [i 0]
+	       [provider
+	         (lambda (_messages tool-specs _step)
+	           (set! i (+ i 1))
+	           (cond
+	             [(= i 1)
+	              (list (make-wtool-call "edit"
+	                      (list (cons "path" target)
+	                            (cons "content" snippet)) #f))]
+	             [(and (> i 1) (< i 12))
+	              (list (make-wtool-call "read"
+	                      (list (cons "path" target)
+	                            (cons "start" 1)
+	                            (cons "end" 2)) #f))]
+	             [(= i 12)
+	              (let ([names (map tool-spec-name tool-specs)])
+	                (set! forced-edit-specs?
+	                  (and (member "edit" names)
+	                       (not (member "read" names))
+	                       (not (member "list" names))
+	                       (not (member "balance" names))
+	                       #t))
+	                (list (make-wtool-call "edit"
+	                        (list (cons "path" target)
+	                              (cons "content" full)) #f)))]
+	             [(= i 13)
+	              (list (make-wtool-call "verify" '() #f))]
+	             [else
+	              (list (make-wtool-call "done"
+	                      '(("summary" . "incomplete-create-pressure-ok")) #f))]))])
+	  (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)))]
+	         [result (verified-run provider "pressure edit after incomplete missing create"
+	                   (list (cons 'cwd vr-dir)
+	                         (cons 'verify-command
+	                               (string-append "grep -q fixed " target))
+	                         (cons 'write-scope scope)
+	                         (cons 'max-iterations 16)
+	                         (cons 'max-tool-errors 3)))])
+	    (check! "verified-run: incomplete create pressure reaches done"
+	            result "VERIFIED: exit 0\n")
+	    (check! "verified-run: incomplete create pressure hides inspection"
+	            forced-edit-specs? #t))
+	  (safe-delete-test-file! target-path))
+
 	(let* ([vr-dir  "/tmp"]
 	       [target "jcode-verified-replace-range.ss"]
 	       [target-path (string-append vr-dir "/" target)]