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

actually run the tests (and actually stop running the tests)

Browse Source 
svn: r16363
This commit is contained in:
Robby Findler 2009-10-18 20:27:41 +00:00
parent 2064861baa
commit 2cd7bdc422
1 changed files with 20 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

32
collects/srfi/32/test.scm
View File

@ -1,4 +1,6 @@
(require "sort.scm" #lang scheme/base
(require "sort.ss"
"vector-util.scm" "vector-util.scm"
srfi/27) srfi/27)
@ -52,17 +54,20 @@
(not (vector-sorted? my< v1))) (not (vector-sorted? my< v1)))
(list v v1 v2 v3 v4)))) (list v v1 v2 v3 v4))))
(define (do-test max-size) (define (do-test max-size [max-iterations #f])
(let lp ((i 0)) (let lp ((i 0)
(let ((i (cond ((= i 1000) (total-iterations 0))
(write-char #\.) (when (or (not max-iterations)
(flush-output (current-output-port)) (< total-iterations max-iterations))
0) (let ((i (cond ((= i 1000)
(else (+ i 1)))) (write-char #\.)
(v (random-vector (random-integer max-size)))) (flush-output (current-output-port))
(cond ((unstable-sort-test v) => (lambda (x) (cons 'u x))) 0)
((stable-sort-test v) => (lambda (x) (cons 's x))) (else (+ i 1))))
(else (lp i)))))) (v (random-vector (random-integer max-size))))
(cond ((unstable-sort-test v) => (lambda (x) (cons 'u x)))
((stable-sort-test v) => (lambda (x) (cons 's x)))
(else (lp i (+ total-iterations 1))))))))
(define (random-vector size) (define (random-vector size)
(let ((v (make-vector size))) (let ((v (make-vector size)))
@ -74,3 +79,6 @@
(do ((i (- (vector-length v) 1) (- i 1))) (do ((i (- (vector-length v) 1) (- i 1)))
((< i 0)) ((< i 0))
(vector-set! v i (- (random-integer range) half))))) (vector-set! v i (- (random-integer range) half)))))
(do-test 100 10000)