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"
srfi/27)
@ -52,17 +54,20 @@
(not (vector-sorted? my< v1)))
(list v v1 v2 v3 v4))))
(define (do-test max-size)
(let lp ((i 0))
(let ((i (cond ((= i 1000)
(write-char #\.)
(flush-output (current-output-port))
0)
(else (+ i 1))))
(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))))))
(define (do-test max-size [max-iterations #f])
(let lp ((i 0)
(total-iterations 0))
(when (or (not max-iterations)
(< total-iterations max-iterations))
(let ((i (cond ((= i 1000)
(write-char #\.)
(flush-output (current-output-port))
0)
(else (+ i 1))))
(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)
(let ((v (make-vector size)))
@ -74,3 +79,6 @@
(do ((i (- (vector-length v) 1) (- i 1)))
((< i 0))
(vector-set! v i (- (random-integer range) half)))))
(do-test 100 10000)