added --seek

rad/main.scm

@@ -74,6 +74,8 @@ Radamsa was written by Aki Helin at OUSPG.")
                   comment "save metadata about generated files to this file")
               (recursive "-r" "--recursive"
                   comment "include files in subdirectories")
+              (offset "-S" "--seek" cook ,string->integer
+                  comment "start from given testcase")
               (delay "-d" "--delay" cook ,string->natural
                   comment "sleep for n milliseconds between outputs")
               (list "-l" "--list" comment "list mutations, patterns and generators")
@@ -214,7 +216,7 @@ Radamsa was written by Aki Helin at OUSPG.")
                   ((os 
                      (string->outputs 
                         (getf dict 'output-pattern)
-                        (getf dict 'count)
+                        (+ (getf dict 'count) (get dict 'offset 0))
                         (pick-suffix paths))))
                   (if os
                      (start-radamsa (put dict 'output os) paths)
@@ -244,26 +246,30 @@ Radamsa was written by Aki Helin at OUSPG.")
                         (getf dict 'verbose)
                         fail))
                    (n (getf dict 'count))
+                   (end (+ n (get dict 'offset 0)))
                    (mutas (getf dict 'mutations))
                    (rs muta (mutators->mutator rs mutas))
                    (sleeper
                     (let ((n (getf dict 'delay)))
                       (if n (λ () (sleep n)) (λ () 42))))
                    (gen 
                      (generator-priorities->generator rs
-                        (getf dict 'generators) paths fail (getf dict 'count))))
+                        (getf dict 'generators) paths fail end)))
                   ;; possibly save the seed to metadata
                   (record-meta (put empty 'seed (getf dict 'seed)))
                   (let loop 
                      ((rs rs)
                       (muta muta)
                       (pat (getf dict 'patterns))
                       (out (get dict 'output 'bug))
-                      (p 1))
-                     (if (and (number? n) (< n p)) ; n can be 'infinity
-                        (begin
-                           (record-meta 'close)
-                           0)
+                      (offset (get dict 'offset 1))
+                      (p 1) 
+                      (left (if (number? n) n -1)))
+                     (cond
+                      ((= left 0)
+                         (record-meta 'close)
+                         0)
+                      ((eq? offset 1)
                         (lets/cc ret
                            ((rs ll meta (gen rs))
                             (meta (put meta 'nth p))
@@ -273,7 +279,13 @@ Radamsa was written by Aki Helin at OUSPG.")
                             (meta (put meta 'length n-written)))
                            (record-meta meta)
                            (sleeper)
-                           (loop rs muta pat out (+ p 1)))))))))
+                           (loop rs muta pat out 1 (+ p 1) (- left 1))))
+                      (else
+                        (lets 
+                          ((rs ll meta (gen rs))
+                           (meta (put meta 'nth p))
+                           (rs muta meta (dummy-output (pat rs ll muta meta))))
+                          (loop rs muta pat out (- offset 1) (+ p 1) left)))))))))
 
       (define (radamsa args)
          (process-arguments (cdr args) 

rad/output.scm

@@ -12,6 +12,7 @@
 
    (export
       output
+      dummy-output        ;; construct, but don't write
       string->outputs)    ;; str num → ll of output functions | #false
 
    (begin
@@ -21,13 +22,19 @@
          (lets 
             ((ll n (blocks->port ll fd))
              (ok? (and (pair? ll) (tuple? (car ll)))) ;; all written?
-             (state (lfold (λ (last block) block) #false ll)) ;; find the last tuple
+             (state (lfold (λ (prev this) this) #f ll)) ;; find the last tuple
              (rs muta meta state))
             (if (not (eq? fd stdout))
                (close-port fd))
             ;; could warn about write errors
             (values rs muta meta n)))
 
+      (define (dummy-output ll)
+        (lets
+          ((state (lfold (λ (prev this) this) #f ll))
+           (rs muta meta state))
+          (values rs muta meta)))
+
       (define (stdout-stream meta)
          (values stdout-stream stdout 
             (put meta 'output 'stdout)))

tests/seek.sh

@@ -0,0 +1,19 @@
+#!/bin/bash
+
+set -e
+
+SEED=$RANDOM
+
+echo "HAL 9000" | $@ --seed $SEED -o tmp/seek-1-%n -n 20
+echo "HAL 9000" | $@ --seed $SEED -o tmp/seek-2-%n --seek 19 -n 2
+
+echo "HAL 9000" | $@ --seed $SEED -o tmp/seek-2-%n --seek 10
+
+cmp tmp/seek-1-10 tmp/seek-2-10 || exit 1
+cmp tmp/seek-1-19 tmp/seek-2-19 || exit 1
+cmp tmp/seek-1-20 tmp/seek-2-20 || exit 1
+
+test -f tmp/seek-2-18 && exit 2
+test -f tmp/seek-2-21 && exit 2
+
+rm tmp/seek-*