Repair random piece index failures

ober

73fa5232c3d5a921eabe15ea339bb0cf220cc427

diff --git a/src/jcode/core/verified-run.ss b/src/jcode/core/verified-run.ss
index 8a28125..65c4dd9 100644
--- a/src/jcode/core/verified-run.ss
+++ b/src/jcode/core/verified-run.ss
@@ -1787,6 +1787,41 @@
                               path first last first
                               'piece-index candidate)))))))))
 
+(def (piece-type-random-index-repair detail cwd)
+  (and (string-contains detail "Exception in vector-ref: -1 is not a valid index")
+       (or (string-contains detail "incorrect argument count in call (random)")
+           (string-contains detail "possible incorrect argument count in call (random)"))
+       (let ((source (source-containing-symbol cwd "PIECE-SHAPES")))
+         (and source
+              (let* ((path (car source))
+                     (content (cadr source))
+                     (lines (string-split content #\newline))
+                     (first #f)
+                     (last #f))
+                (let loop ((rest lines) (line-no 1))
+                  (unless (null? rest)
+                    (when (string-contains (car rest)
+                            "(modulo (random) 7)")
+                      (unless first (set! first line-no))
+                      (set! last line-no))
+                    (loop (cdr rest) (+ line-no 1))))
+                (and first last
+                     (let* ((span
+                              (string-join
+                                (take-up-to
+                                  (list-tail lines (- first 1))
+                                  (+ (- last first) 1))
+                                "\n"))
+                            (candidate
+                              (replace-all
+                                span
+                                "(modulo (random) 7)"
+                                "(random 7)")))
+                       (and (not (string=? span candidate))
+                            (make-required-range-repair
+                              path first last first
+                              'piece-random candidate)))))))))
+
 (def (self-test-game-over-repair detail cwd)
   (and (string-contains detail
          "Exception in self-test: expected game over")
@@ -1821,6 +1856,7 @@
       (qt-lifecycle-repair detail cwd)
       (self-test-command-line-repair detail cwd)
       (self-test-game-over-repair detail cwd)
+      (piece-type-random-index-repair detail cwd)
       (piece-shapes-index-repair detail cwd)
       (unexpected-close-repair detail cwd)))
 
@@ -2192,6 +2228,14 @@
            (best-repair-candidate-text
              cwd repair (required-repair-label repair))))))
 
+(def (piece-type-random-index-diagnosis detail cwd)
+  (let ((repair (piece-type-random-index-repair detail cwd)))
+    (and repair
+         (string-append
+           "\n\nPiece random index diagnosis: the verifier reported `PIECE-SHAPES` being indexed at `-1` after a `(random)` arity warning. The current generator subtracts one from piece ids later, so `(modulo (random) 7)` can produce a bad zero-valued piece id. jcode constructed the local repair to use `(random 7)` inside the existing `(+ ... 1)` expression, preserving ids 1..7. Apply it and verify immediately."
+           (best-repair-candidate-text
+             cwd repair (required-repair-label repair))))))
+
 (def (augment-verify-detail detail cwd)
   (let* ((diagnosis (or (invalid-context-diagnosis detail cwd)
                         (empty-body-diagnosis detail cwd)
@@ -2204,6 +2248,7 @@
                         (qt-lifecycle-diagnosis detail cwd)
                         (self-test-command-line-diagnosis detail cwd)
                         (self-test-game-over-diagnosis detail cwd)
+                        (piece-type-random-index-diagnosis detail cwd)
                         (unexpected-close-diagnosis detail cwd)))
          (base (if diagnosis
                  (string-append detail diagnosis)
@@ -3288,7 +3333,8 @@
 (def (candidate-required-repair? repair)
   (member (repair-ref repair 'kind)
           '(syntax syntax-auto call-arity unbound-symbol runtime-arity
-            qt-lifecycle command-line self-test-logic piece-index)))
+            qt-lifecycle command-line self-test-logic piece-index
+            piece-random)))
 
 (def (automatic-required-repair-call)
   (let* ((repair (current-required-range-repair))
@@ -3298,7 +3344,7 @@
 	         (member kind
 	                 '(syntax-auto call-arity unbound-symbol runtime-arity
 	                   qt-lifecycle command-line self-test-logic
-                     piece-index delimiter))
+                     piece-index piece-random delimiter))
          (list
            (make-wtool-call
              "replace_range"
diff --git a/test/run.ss b/test/run.ss
index 8e84331..bd9c7c9 100644
--- a/test/run.ss
+++ b/test/run.ss
@@ -3561,6 +3561,51 @@
 	  (safe-delete-test-file! target-path))
 
 	(let* ([vr-dir "/tmp"]
+	       [target "jcode-local-piece-random-index-auto-repair.ss"]
+	       [target-path (string-append vr-dir "/" target)]
+	       [initial
+	         (string-append
+	           "(import (jerboa prelude))\n"
+	           "(def PIECE-SHAPES (vector 'a 'b 'c 'd 'e 'f 'g))\n"
+	           "(def next-type (atom 1))\n"
+	           "(def (next-piece-type)\n"
+	           "  (let ((n (atom-deref next-type)))\n"
+	           "    (atom-reset! next-type (+ (modulo (random) 7) 1))\n"
+	           "    n))\n"
+	           "(def (shape type)\n"
+	           "  (vector-ref PIECE-SHAPES (- type 1)))\n")]
+	       [responder
+	         (scripted-responder
+	           (list (list (make-wtool-call "verify" '() #f))))]
+	       [verify-command
+	         (string-append
+	           "if grep -F -q '(modulo (random) 7)' " target
+	           "; then echo 'Warning in compile: possible incorrect argument count in call (random) at line 6, char 39 of "
+	           target
+	           "'; echo 'Exception in vector-ref: -1 is not a valid index for #(a b c d e f g)'; exit 1; fi")])
+	  (safe-delete-test-file! target-path)
+	  (call-with-output-file target-path
+	    (lambda (p) (display initial p)) 'replace)
+	  (let ([result
+	          (verified-run responder "repair random piece index"
+	            (list
+	              (cons 'cwd vr-dir)
+	              (cons 'verify-command verify-command)
+	              (cons 'write-scope (parse-write-scope target))
+	              (cons 'local-model? #t)
+	              (cons 'max-iterations 5)
+	              (cons 'max-tool-errors 2)))])
+	    (check! "verified-run: automatic piece random index repair verifies"
+	            result "VERIFIED: exit 0\n"))
+	  (check-pred! "verified-run: piece random index keeps ids one based"
+	    (call-with-input-file target-path (lambda (p) (get-string-all p)))
+	    (lambda (s)
+	      (and (str-contains? s
+	             "(atom-reset! next-type (+ (random 7) 1))")
+	           (not (str-contains? s "(modulo (random) 7)")))))
+	  (safe-delete-test-file! target-path))
+
+	(let* ([vr-dir "/tmp"]
 	       [target "jcode-local-runtime-arity-repair.ss"]
 	       [target-path (string-append vr-dir "/" target)]
 	       [initial