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

make the contract random generator sometimes

Browse Source 
generate inexact/exact variants of numbers
when the exact/inexact one was originally
present in the contract
This commit is contained in:
Robby Findler 2015-01-23 22:25:57 -06:00
parent cc642c3382
commit eb7c6653f3
2 changed files with 19 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
pkgs/racket-test/tests/racket/contract-rand-test.rkt
View File

@ -26,7 +26,12 @@
(check-not-exn (λ () (test-contract-generation natural-number/c)))
;; test =, eq?, and equal? contract random generators
(check-not-exn (λ () (test-contract-generation 1/2)))
(check-not-exn (λ () (test-contract-generation 1/3)))
(check-not-exn (λ () (test-contract-generation 0)))
(check-not-exn (λ () (test-contract-generation 1)))
(check-not-exn (λ () (test-contract-generation 1.0)))
(check-not-exn (λ () (test-contract-generation (expt 10 200))))
(check-not-exn (λ () (test-contract-generation +nan.0)))
(check-not-exn (λ () (test-contract-generation 'x)))
(check-not-exn (λ () (test-contract-generation "x")))

15
racket/collects/racket/contract/private/guts.rkt
View File

@ -445,7 +445,20 @@
#:generate
(λ (ctc)
(define v (=-contract-val ctc))
(λ (fuel) (λ () v)))))
(λ (fuel)
(λ ()
(case (random 5)
[(0) (cond
[(exact? v)
(define iv (exact->inexact v))
(if (= iv v) iv v)]
[(and (inexact? v)
(not (memv v '(+inf.0 -inf.0 +inf.f -inf.f
nan.0 nan.f))))
(define ev (inexact->exact v))
(if (= ev v) ev v)]
[else v])]
[else v]))))))
(define-struct regexp/c (reg name)
#:property prop:custom-write contract-custom-write-property-proc