syndicate-lang
/
syndicate-2017
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

Parameters for random-test defaults; random-test index-limit

This commit is contained in:
Tony Garnock-Jones 2016-03-10 23:29:05 +00:00
parent 88a5522d2f
commit e780417355
1 changed files with 19 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

26
prospect/random-test.rkt
View File

@ -7,6 +7,10 @@
(struct-out property-check-result:fail) (struct-out property-check-result:fail)
(struct-out property-check-result:gave-up) (struct-out property-check-result:gave-up)
(struct-out property-check-result:invalid-prop) (struct-out property-check-result:invalid-prop)
random-test:max-tests
random-test:max-rejected-ratio
random-test:index-limit
random-test:quiet?
check-property* check-property*
check-property check-property
reject-test reject-test
@ -28,16 +32,22 @@
(struct property-check-result:gave-up property-check-result:ok () #:transparent) (struct property-check-result:gave-up property-check-result:ok () #:transparent)
(struct property-check-result:invalid-prop property-check-result:fail () #:transparent) (struct property-check-result:invalid-prop property-check-result:fail () #:transparent)
(define random-test:max-tests (make-parameter 100))
(define random-test:max-rejected-ratio (make-parameter 10))
(define random-test:index-limit (make-parameter #f))
(define random-test:quiet? (make-parameter #f))
(define (summarise-check-count name n-tests n-rejected) (define (summarise-check-count name n-tests n-rejected)
(printf "\rChecking ~a; ~a tests / ~a rejected" name n-tests n-rejected) (printf "\rChecking ~a; ~a tests / ~a rejected" name n-tests n-rejected)
(flush-output)) (flush-output))
(define (check-property* prop (define (check-property* prop
#:max-tests [max-tests 100] #:max-tests [max-tests (random-test:max-tests)]
#:max-rejected-ratio [max-rejected-ratio 10] #:max-rejected-ratio [max-rejected-ratio (random-test:max-rejected-ratio)]
#:min-rejected-tests [min-rejected-tests (* max-rejected-ratio max-tests)] #:min-rejected-tests [min-rejected-tests (* max-rejected-ratio max-tests)]
#:index-limit [index-limit (random-test:index-limit)]
#:name [name (object-name prop)] #:name [name (object-name prop)]
#:quiet? [quiet? #f] #:quiet? [quiet? (random-test:quiet?)]
. enums) . enums)
(define args/e (apply list/e enums)) (define args/e (apply list/e enums))
(begin0 (begin0
@ -53,7 +63,7 @@
(unless quiet? (summarise-check-count name n-tests n-rejected)) (unless quiet? (summarise-check-count name n-tests n-rejected))
(property-check-result:ok name prop n-tests n-rejected)] (property-check-result:ok name prop n-tests n-rejected)]
[else [else
(define args-index (random-index args/e)) (define args-index (if index-limit (random index-limit) (random-index args/e)))
(define args (from-nat args/e args-index)) (define args (from-nat args/e args-index))
(with-handlers [[exn:fail:reject-test? (lambda (_exn) (loop n-tests (+ n-rejected 1)))]] (with-handlers [[exn:fail:reject-test? (lambda (_exn) (loop n-tests (+ n-rejected 1)))]]
(unless quiet? (summarise-check-count name n-tests n-rejected)) (unless quiet? (summarise-check-count name n-tests n-rejected))
@ -81,11 +91,12 @@
(lambda () (fail-check message)))) (lambda () (fail-check message))))
(define (check-property prop (define (check-property prop
#:max-tests [max-tests 100] #:max-tests [max-tests (random-test:max-tests)]
#:max-rejected-ratio [max-rejected-ratio 10] #:max-rejected-ratio [max-rejected-ratio (random-test:max-rejected-ratio)]
#:min-rejected-tests [min-rejected-tests (* max-rejected-ratio max-tests)] #:min-rejected-tests [min-rejected-tests (* max-rejected-ratio max-tests)]
#:index-limit [index-limit (random-test:index-limit)]
#:name [name (object-name prop)] #:name [name (object-name prop)]
#:quiet? [quiet? #f] #:quiet? [quiet? (random-test:quiet?)]
. enums) . enums)
((current-check-around) ((current-check-around)
(lambda () (lambda ()
@ -93,6 +104,7 @@
#:max-tests max-tests #:max-tests max-tests
#:max-rejected-ratio max-rejected-ratio #:max-rejected-ratio max-rejected-ratio
#:min-rejected-tests min-rejected-tests #:min-rejected-tests min-rejected-tests
#:index-limit index-limit
#:name name #:name name
#:quiet? quiet?)) #:quiet? quiet?))
(match result (match result