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

Misc improvements

Browse Source
This commit is contained in:
Eli Barzilay 2011-06-29 16:48:11 -04:00
parent 226f86d201
commit 3e755eba11
1 changed files with 24 additions and 41 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -1,54 +1,37 @@
#lang racket
(require racket/runtime-path)
(require setup/dirs)
(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 (flip-bit bs idx)
(define-values [byte bit] (quotient/remainder idx 8))
(define val (bytes-ref bs byte))
(bytes-set! bs byte (flip val bit)))
(bytes-set! bs byte (bitwise-xor (expt 2 bit) val)))
(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)
(printf "name: ~a\n" fname)
(define (run fname seed0)
(define seed (or seed0 (+ 1 (random (expt 2 30)))))
(printf "seed: ~s\nname: ~a\n" seed fname)
(flush-output)
(random-seed seed)
(define bs (file->bytes fname))
(define len (* 8 (bytes-length bs)))
(for ([i (in-range (quotient len 10000))])
(flip-file bs (random len)))
(with-handlers ([void void])
(run-file bs)))
(define collects-dir
(find-executable-path (find-system-path 'exec-file)
(find-system-path 'collects-dir)))
(for ([i (in-range (quotient len 10000))]) (flip-bit bs (random len)))
(with-handlers ([void void]) (run-file bs)))
(let ([seed #f] [file #f] [dir #f])
(command-line
#:once-each
["-s" seed "random seed" (set! sd (string->number seed))]
["-s" seed "random seed" (set! seed (string->number seed))]
#:once-any
["-f" file "filename to run"
(set! fl file)]
["-f" file "filename to run" (set! file file)]
["-d" dir* "dir to run" (set! dir dir*)]
["-c" "run over all collections"
(set! dir collects-dir)]
["-c" "run over all collections" (set! dir (find-collects-dir))]
#:args () (void))
(cond [fl (run fl)]
(cond [file (run file seed)]
[dir (for ([p (in-directory dir)]
#:when (regexp-match "\\.zo" p))
(run p))])
#:when (regexp-match #rx"\\.zo" p))
(run p seed))]
[else (printf "Nothing to do.\n")]))