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

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

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