suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Global seed to debug fuzzer timeouts.

Browse Source
This commit is contained in:
Sam Tobin-Hochstadt 2011-12-15 13:36:12 -05:00
parent fd89d560b2
commit ff74b262cf
2 changed files with 9 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
collects/meta/props
View File

@ -1867,7 +1867,7 @@ path/s is either such a string or a list of them.
"collects/tests/racket/stress" responsible (jay) "collects/tests/racket/stress" responsible (jay)
"collects/tests/racket/stress/contract-lifting.rkt" responsible (robby sstrickl) "collects/tests/racket/stress/contract-lifting.rkt" responsible (robby sstrickl)
"collects/tests/racket/stress/dict.rkt" drdr:timeout 180 "collects/tests/racket/stress/dict.rkt" drdr:timeout 180
"collects/tests/racket/stress/fuzz.rkt" responsible (samth mflatt) drdr:command-line (racket "-t" * "--" "-c") drdr:random #t "collects/tests/racket/stress/fuzz.rkt" responsible (samth mflatt) drdr:command-line (racket "-t" * "--" "-c") drdr:timeout 300 drdr:random #t
"collects/tests/racket/stress/module-stack.rkt" drdr:timeout 180 "collects/tests/racket/stress/module-stack.rkt" drdr:timeout 180
"collects/tests/racket/string-mzlib.rktl" drdr:command-line (racket "-f" *) "collects/tests/racket/string-mzlib.rktl" drdr:command-line (racket "-f" *)
"collects/tests/racket/string.rktl" drdr:command-line (racket "-f" *) "collects/tests/racket/string.rktl" drdr:command-line (racket "-f" *)

10
collects/tests/racket/stress/fuzz.rkt
View File

@ -28,16 +28,22 @@
(for ([i (in-range (quotient len 10000))]) (flip-bit bs (random len))) (for ([i (in-range (quotient len 10000))]) (flip-bit bs (random len)))
(with-handlers ([void void]) (run-file bs))) (with-handlers ([void void]) (run-file bs)))
(let ([seed0 #f] [file #f] [dir #f] [forever? #f]) (let ([seed0 #f] [file #f] [dir #f] [forever? #f] [global-seed #f])
(command-line (command-line
#:once-each #:once-each
["-s" seed "random seed" (set! seed0 (string->number seed))]
["--oo" "forever" (set! forever? #t)] ["--oo" "forever" (set! forever? #t)]
#:once-any #:once-any
["-g" global-seed* "gloabl random seed" (set! global-seed (string->number global-seed*))]
["-s" seed "random seed" (set! seed0 (string->number seed))]
#:once-any
["-f" file* "filename to run" (set! file file*)] ["-f" file* "filename to run" (set! file file*)]
["-d" dir* "dir to run" (set! dir dir*)] ["-d" dir* "dir to run" (set! dir dir*)]
["-c" "run over all collections" (set! dir (find-collects-dir))] ["-c" "run over all collections" (set! dir (find-collects-dir))]
#:args () (void)) #: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 () (let loop ()
(cond [file (run file seed0)] (cond [file (run file seed0)]
[dir (for ([p (in-directory dir)] [dir (for ([p (in-directory dir)]