From dfef5b43fc8e87c5038f13429d45e10af77e6092 Mon Sep 17 00:00:00 2001
From: Sam Tobin-Hochstadt <samth@cs.indiana.edu>
Date: Wed, 23 Sep 2015 15:49:01 -0400
Subject: [PATCH] Add `--write` option to fuzzer.

---
 pkgs/racket-test/tests/racket/stress/fuzz.rkt | 19 +++++++++++++++----
 1 file changed, 15 insertions(+), 4 deletions(-)

diff --git a/pkgs/racket-test/tests/racket/stress/fuzz.rkt b/pkgs/racket-test/tests/racket/stress/fuzz.rkt
index cd18869be7..fc7c706939 100644
--- a/pkgs/racket-test/tests/racket/stress/fuzz.rkt
+++ b/pkgs/racket-test/tests/racket/stress/fuzz.rkt
@@ -18,7 +18,7 @@
           (eval (parameterize ([read-accept-compiled #t])
                   (with-input-from-bytes bs read)))))))))
 
-(define (run fname seed0)
+(define (run fname seed0 #:write? [out-fname? #f])
   (define seed (or seed0 (+ 1 (random (expt 2 30)))))
   (printf "seed: ~s\nname: ~a\n" seed fname)
   (flush-output)
@@ -26,9 +26,16 @@
   (define bs  (file->bytes fname))
   (define len (* 8 (bytes-length bs)))
   (for ([i (in-range (quotient len 10000))]) (flip-bit bs (random len)))
-  (with-handlers ([void void]) (run-file bs)))
+  (with-handlers ([void void]) 
+    (if out-fname?
+        (begin
+          (displayln (build-path (current-directory) out-fname?))
+          (call-with-output-file (build-path (current-directory) out-fname?)
+            (lambda (o)
+              (write-bytes bs o))))
+        (run-file bs))))
 
-(let ([seed0 #f] [file #f] [dir #f] [forever? #f] [global-seed #f])
+(let ([seed0 #f] [file #f] [dir #f] [forever? #f] [global-seed #f] [write? #f])
   (command-line
    #:once-each
    ["--oo" "forever" (set! forever? #t)]
@@ -39,13 +46,17 @@
    ["-f" file* "filename to run"     (set! file file*)]
    ["-d" dir* "dir to run"          (set! dir dir*)]
    ["-c" "run over all collections" (set! dir (find-collects-dir))]
+   #:once-any
+   ["--write" filename "write mutated file" (begin (unless file
+                                                     (error "--write requires -f"))
+                                                   (set! write? filename))]
    #:args () (void))
   (unless global-seed
     (set! global-seed (+ 1 (random (expt 2 30)))))
   (printf "Global seed: ~a\n" global-seed)
   (random-seed global-seed)
   (let loop ()
-    (cond [file (run file seed0)]
+    (cond [file (run file seed0 #:write? write?)]
           [dir 
 	   (define files (sort (for/list ([f (in-directory dir)]
 					  #:when (regexp-match #rx"\\.zo" f))