diff --git a/collects/meta/props b/collects/meta/props index 9cb417b48b..d4d81c8314 100755 --- a/collects/meta/props +++ b/collects/meta/props @@ -1892,6 +1892,7 @@ path/s is either such a string or a list of them. "collects/tests/stepper/undefined.rktl" drdr:command-line #f "collects/tests/stepper/world-test.rktl" drdr:command-line #f "collects/tests/stepper/write-display.rktl" drdr:command-line #f +"collects/tests/stress/fuzz.rkt" responsible (samth mflatt) drdr:command-line (racket "-t" * "-c") "collects/tests/stress.rkt" responsible (jay) "collects/tests/stxparse" responsible (ryanc) "collects/tests/stxparse/stxclass.rkt" drdr:command-line (gracket-text "-t" *) diff --git a/collects/tests/stress/fuzz.rkt b/collects/tests/stress/fuzz.rkt new file mode 100644 index 0000000000..0e1474b622 --- /dev/null +++ b/collects/tests/stress/fuzz.rkt @@ -0,0 +1,50 @@ +#lang racket + +(define (flip n bit) + (define new-bit (expt 2 bit)) + (bitwise-xor new-bit n)) + +(define (flip-file bs idx) + (define-values (byte bit) (quotient/remainder idx 8)) + (define val (bytes-ref bs byte)) + (bytes-set! bs byte (flip val bit))) + +(define (run-file bs) + (eval (parameterize ([read-accept-compiled #t]) + (with-input-from-bytes bs read)))) + + +(define sd #f) +(define fl #f) +(define dir #f) + +(define (run fname [seed (or sd (+ 1 (random (expt 2 30))))]) + (printf "DrDr Ignore! random-seed ~s\n" seed) + (random-seed seed) + (define bs (file->bytes fname)) + (define len (* 8 (bytes-length bs))) + (printf "name: ~a\n" fname) + (for ([i (in-range (quotient len 10000))]) + (flip-file bs (random len))) + (with-handlers ([void void]) + (run-file bs))) + + +(command-line + #:once-each + ["-s" seed "random seed" (set! sd (string->number seed))] + #:once-any + ["-f" file "filename to run" + (set! fl file)] + ["-d" dir* "dir to run" (set! dir dir*)] + ["-c" "run over all collections" + (set! dir (find-executable-path (find-system-path 'exec-file) + (find-system-path 'collects-dir)))] + #:args () (void)) + +(displayln dir) + +(cond [fl (run fl)] + [dir (for ([p (in-directory dir)] + #:when (regexp-match "\\.zo" p)) + (run p))])