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

Refactoring.

Browse Source
This commit is contained in:
Sam Tobin-Hochstadt 2015-10-11 14:03:24 -04:00
parent e53492a68f
commit f63188b4ea
1 changed files with 61 additions and 33 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

94
pkgs/racket-test/tests/racket/stress/fuzz.rkt
View File

@ -7,7 +7,7 @@
(define val (bytes-ref bs byte)) (define val (bytes-ref bs byte))
(bytes-set! bs byte (bitwise-xor (expt 2 bit) val))) (bytes-set! bs byte (bitwise-xor (expt 2 bit) val)))
(define (run-file bs) (define (run-bytes bs)
(sync (sync
(parameterize ([current-custodian (make-custodian)]) (parameterize ([current-custodian (make-custodian)])
(thread (thread
@ -18,7 +18,7 @@
(eval (parameterize ([read-accept-compiled #t]) (eval (parameterize ([read-accept-compiled #t])
(with-input-from-bytes bs read))))))))) (with-input-from-bytes bs read)))))))))
(define (run fname seed0 #:write? [out-fname? #f]) (define (run-file fname seed0 #:write? [out-fname? #f])
(define seed (or seed0 (+ 1 (random (expt 2 30))))) (define seed (or seed0 (+ 1 (random (expt 2 30)))))
(printf "seed: ~s\nname: ~a\n" seed fname) (printf "seed: ~s\nname: ~a\n" seed fname)
(flush-output) (flush-output)
@ -33,44 +33,72 @@
(call-with-output-file (build-path (current-directory) out-fname?) (call-with-output-file (build-path (current-directory) out-fname?)
(lambda (o) (lambda (o)
(write-bytes bs o)))) (write-bytes bs o))))
(run-file bs)))) (run-bytes bs))))
(let ([seed0 #f] [file #f] [dir #f] [forever? #f] [global-seed #f] [write? #f]) (define (go)
(command-line (let ([seed0 #f] [file #f] [dir #f] [forever? #f] [global-seed #f] [write? #f])
#:once-each (printf ">>> ~s\n" (current-command-line-arguments))
["--oo" "forever" (set! forever? #t)] (command-line
#:once-any #:once-each
["-g" global-seed* "gloabl random seed" (set! global-seed (string->number global-seed*))] ["--oo" "forever" (set! forever? #t)]
["-s" seed "random seed" (set! seed0 (string->number seed))] #:once-any
#:once-any ["-g" global-seed* "global random seed" (set! global-seed (string->number global-seed*))]
["-f" file* "filename to run" (set! file file*)] ["-s" seed "random seed" (set! seed0 (string->number seed))]
["-d" dir* "dir to run" (set! dir dir*)] #:once-any
["-c" "run over all collections" (set! dir (find-collects-dir))] ["-f" file* "filename to run" (set! file file*)]
#:once-any ["-d" dir* "dir to run" (set! dir dir*)]
["--write" filename "write mutated file" (begin (unless file ["-c" "run over all collections" (set! dir (find-collects-dir))]
(error "--write requires -f")) #:once-any
(set! write? filename))] ["--write" filename "write mutated file" (begin (unless file
#:args () (void)) (error "--write requires -f"))
(cond [global-seed] (set! write? filename))]
[(getenv "RACKET_FUZZ_GLOBAL_SEED") => (lambda (v) (set! global-seed (string->number v)))] #:args () (void))
[else (set! global-seed (+ 1 (random (expt 2 30))))]) (cond [global-seed]
[(getenv "RACKET_FUZZ_GLOBAL_SEED") => (lambda (v) (set! global-seed (string->number v)))]
[else (set! global-seed (+ 1 (random (expt 2 30))))])
(run seed0 file dir forever? global-seed write?)))
(define (run seed0 file dir forever? global-seed write?)
(printf "Global seed: ~a\n" global-seed) (printf "Global seed: ~a\n" global-seed)
(random-seed global-seed) (random-seed global-seed)
(let loop () (let loop ()
(cond [file (run file seed0 #:write? write?)] (cond [file (run-file file seed0 #:write? write?)]
[dir [dir
(define files (sort (for/list ([f (in-directory dir)] (define files (sort (for/list ([f (in-directory dir)]
#:when (regexp-match #rx"\\.zo" f)) #:when (regexp-match #rx"\\.zo" f))
f) f)
#:key path->string #:key path->string
string<?)) string<?))
(for ([p files]) (run p seed0))] (for ([p files]) (run-file p seed0))]
[else (printf "Nothing to do.\n")]) [else (printf "Nothing to do.\n")])
(when forever? (loop)))) (when forever? (loop))))
(module test racket/base (module+ main
(require syntax/location) (let ([seed0 #f] [file #f] [dir #f] [forever? #f] [global-seed #f] [write? #f])
(parameterize ([current-command-line-arguments (vector "-c")]) (printf ">>> ~s\n" (current-command-line-arguments))
(dynamic-require (quote-module-path "..") #f)) (command-line
#:once-each
["--oo" "forever" (set! forever? #t)]
#:once-any
["-g" global-seed* "global 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*)]
["-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))
(cond [global-seed]
[(getenv "RACKET_FUZZ_GLOBAL_SEED") => (lambda (v) (set! global-seed (string->number v)))]
[else (set! global-seed (+ 1 (random (expt 2 30))))])
(run seed0 file dir forever? global-seed write?)))
(module+ test
(require racket/vector syntax/location)
(parameterize ([current-command-line-arguments (vector-append #("-c") (current-command-line-arguments))])
(dynamic-require (quote-module-path ".." main) #f))
(module config info (module config info
(define random? #t))) (define random? #t)))