Block prefix rewrites during required repairs
ober
17d5c19dc92a5031e4303468822e96e7e378fb52
--- a/src/jcode/core/verified-run.ss +++ b/src/jcode/core/verified-run.ss @@ -18,7 +18,9 @@ coding-workflow run-verify-command default-verify-command - default-verified-max-iterations) + default-verified-max-iterations + current-required-range-repair + long-prefix-exact-replacement-block-message) (import :std/os/aproc :std/misc/string @@ -4776,6 +4778,19 @@ (format "edit refused for ~a: edit overwrites the whole file. Existing file is ~a bytes, new content is ~a bytes and looks like a snippet. Resend the complete file content." path (string-length old-content) (string-length new-content)))) +(def (long-prefix-exact-replacement-block-message path old-content old-str new-str) + (and (current-required-range-repair) + (source-ss-path? path) + (string? old-content) + (string? old-str) + (string? new-str) + (> (string-length old-str) 1000) + (string-prefix? old-str old-content) + (< (string-length old-str) (string-length old-content)) + (format + "edit refused for ~a: old_str is a long prefix of the current file, not the diagnosed span or the complete file. A verifier-required repair is pending, so this usually preserves the broken tail and repeats syntax-guard failures. For a whole-file replacement, call edit/write with path and content only; for the diagnosed problem, use line_edit or replace_range covering the implicated lines." + path))) + (def (replace-first content old-str new-str) (let ((idx (string-contains content old-str))) (and idx @@ -5634,6 +5649,11 @@ ". The file was not changed. Do not retry a similar long old_str. Use read(path,start,end) to inspect the exact current lines, then call replace_range(path,start,end,content) for the whole broken span or line_edit for one line.") 'edit) (begin + (cond + ((long-prefix-exact-replacement-block-message + path old-content old-str (or new-str "")) + => (lambda (msg) + (raise-recoverable-tool-error msg 'edit)))) (reject-unchanged-edit! 'edit path old-content new-content) (guard-jerboa-syntax-for-local-repair! --- a/test/run.ss +++ b/test/run.ss @@ -4475,6 +4475,45 @@ (not (str-contains? s "(getenv \"TETRIS_SCREENSHOT\" \"/tmp/kratistos-qt-tetris-selftest.png\")"))))) (safe-delete-test-file! target-path)) + (let* ([target "jcode-required-repair-long-prefix-old-str.ss"] + [filler (make-string 1400 #\x)] + [initial + (string-append + "(import (jerboa prelude))\n" + "(def (bug) (foo 1 2))\n" + filler + "\n(def tail \"keep\")\n")] + [prefix (substring initial 0 1250)] + [bad-prefix (string-append prefix "\n(def patched-prefix #t)\n")] + [repair + (list (cons 'path target) + (cons 'start 2) + (cons 'end 2) + (cons 'line 2) + (cons 'kind 'call-arity) + (cons 'candidate #f))] + [msg + (parameterize ([current-required-range-repair repair]) + (long-prefix-exact-replacement-block-message + target initial prefix bad-prefix))] + [full-msg + (parameterize ([current-required-range-repair repair]) + (long-prefix-exact-replacement-block-message + target initial initial bad-prefix))] + [no-repair-msg + (parameterize ([current-required-range-repair #f]) + (long-prefix-exact-replacement-block-message + target initial prefix bad-prefix))]) + (check-pred! "verified-run: long prefix old_str block explains full replacement" + msg + (lambda (s) + (and (str-contains? s "old_str is a long prefix") + (str-contains? s "path and content only")))) + (check! "verified-run: full-file old_str is not long-prefix blocked" + full-msg #f) + (check! "verified-run: long prefix old_str is allowed without required repair" + no-repair-msg #f)) + (let* ([vr-dir "/tmp"] [target "jcode-local-inspected-draft-cap.ss"] [target-path (string-append vr-dir "/" target)]