Force bounded repairs for staged balance candidates

Jaime Fournier <jaimef@linbsd.org>

94997a432c88386b0aed75983df65e5a0a6defc4

diff --git a/src/jcode/core/verified-run.ss b/src/jcode/core/verified-run.ss
index eaa9333..961956b 100644
--- a/src/jcode/core/verified-run.ss
+++ b/src/jcode/core/verified-run.ss
@@ -464,11 +464,17 @@
   ;; failures already carry the exact repair class and should go straight to
   ;; a corrected edit/write turn.
   (and (syntax-broken-missing-create-repair-mode?)
-       (= (current-rejected-draft-inspections) 0)
        (= (current-rejected-draft-path-reject-count) 1)
-       (if (rejected-draft-direct-edit-guard?)
-         (and (tool-specs-include? specs "edit") "edit")
-         (and (tool-specs-include? specs "balance") "balance"))))
+       (cond
+         ((and (current-required-range-repair)
+               (> (current-rejected-draft-inspections) 0))
+          (and (tool-specs-include? specs "replace_range")
+               "replace_range"))
+         ((= (current-rejected-draft-inspections) 0)
+          (if (rejected-draft-direct-edit-guard?)
+            (and (tool-specs-include? specs "edit") "edit")
+            (and (tool-specs-include? specs "balance") "balance")))
+         (else #f))))
 
 (def (forced-first-edit-specs specs forced-choice)
   (if forced-choice
@@ -3110,10 +3116,13 @@
 
 (def (repair-candidate-full-content cwd repair candidate)
   (let* ((path (repair-ref repair 'path))
-         (p (abs-path cwd path)))
-    (and (file-exists? p)
+         (p (abs-path cwd path))
+         (source (or (rejected-draft-content cwd path)
+                     (and (file-exists? p)
+                          (read-file-string p)))))
+    (and source
          (replace-line-range-content
-           (read-file-string p)
+           source
            (repair-ref repair 'start)
            (repair-ref repair 'end)
            candidate))))
@@ -3423,7 +3432,7 @@
     (and line
          (numbered-line-excerpt content line 4 16))))
 
-(def (rejected-draft-structural-repair-hint path content)
+(def (rejected-draft-structural-repair path content)
   (let* ((frames (unclosed-delimiter-frames content))
          (start (minimum-frame-line frames))
          (blocked (minimal-balance-autoclose-blocked-line content))
@@ -3439,14 +3448,22 @@
                 (candidate (minimal-balance-candidate span label)))
            (and candidate
                 (<= (string-length candidate) 4000)
-                (string-append
-                  "\n\nRequired staged repair. Copy this exact bounded candidate; do not read or regenerate the full file:\n"
-                  "replace_range(path=\"" path
-                  "\", start=" (number->string start)
-                  ", end=" (number->string end)
-                  ", content=<the candidate below>)\n"
-                  candidate
-                  "\nThen call verify."))))))
+                (make-required-range-repair
+                  path start end start 'delimiter candidate))))))
+
+(def (rejected-draft-structural-repair-hint path content)
+  (let ((repair (rejected-draft-structural-repair path content)))
+    (and repair
+         (begin
+           (current-required-range-repair repair)
+           (string-append
+             "\n\nRequired staged repair. Copy this exact bounded candidate; do not read or regenerate the full file:\n"
+             "replace_range(path=\"" path
+             "\", start=" (number->string (repair-ref repair 'start))
+             ", end=" (number->string (repair-ref repair 'end))
+             ", content=<the candidate below>)\n"
+             (repair-ref repair 'candidate)
+             "\nThen call verify.")))))
 
 (def (rejected-draft-read-message cwd path args)
   (let ((content (rejected-draft-content cwd path)))
@@ -4634,10 +4651,13 @@
   (let* ((path (repair-ref repair 'path))
          (start (repair-ref repair 'start))
          (end (repair-ref repair 'end))
-         (p (abs-path cwd path)))
-    (and (file-exists? p)
+         (p (abs-path cwd path))
+         (source (or (rejected-draft-content cwd path)
+                     (and (file-exists? p)
+                          (read-file-string p)))))
+    (and source
          (slice-content
-           (read-file-string p)
+           source
            (list (cons "path" path)
                  (cons "start" start)
                  (cons "end" end))))))
diff --git a/test/run.ss b/test/run.ss
index 8ee6992..fe6776f 100644
--- a/test/run.ss
+++ b/test/run.ss
@@ -8863,16 +8863,11 @@
 			      (lambda (xs)
 			        (and (>= (length xs) 2)
 			             (equal? (list-ref xs 1) '("balance")))))
-			    (check-pred! "verified-run: syntax create staged schema restores full retry"
+			    (check-pred! "verified-run: syntax create staged schema forces bounded repair"
 			      (reverse seen-specs)
 			      (lambda (xs)
 			        (and (>= (length xs) 3)
-			             (let ([names (list-ref xs 2)])
-			               (and (member "line_edit" names)
-			                    (member "replace_range" names)
-			                    (member "write" names)
-			                    (member "edit" names)
-			                    (not (member "verify" names))))))))
+			             (equal? (list-ref xs 2) '("replace_range"))))))
 			  (safe-delete-test-file! target-path))
 
 		(let* ([vr-dir  "/tmp"]