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

fix contract random generation for -> when the range is 'any'

Browse Source
This commit is contained in:
Robby Findler 2014-07-29 09:37:05 -05:00
parent a3c7c557ea
commit 7472058fd9
2 changed files with 16 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -84,6 +84,10 @@
(check-exn exn:fail? (λ () ((test-contract-generation (-> char? integer?)) 0)))
(check-not-exn (λ () ((test-contract-generation (-> integer? integer?)) 1)))
(check-not-exn (λ () ((test-contract-generation (-> integer? any)) 1)))
(check-not-exn (λ () ((test-contract-generation (-> integer? (-> integer? any))) 1)))
(check-not-exn (λ () ((test-contract-generation (-> (-> integer? any) integer?))
(λ (i) (values 1 2 3)))))
(check-not-exn (λ () ((test-contract-generation (-> (-> integer? integer?) boolean?)) +)))
(check-not-exn
(λ () ((test-contract-generation (-> some-crazy-predicate? some-crazy-predicate?)) 11)))

21
racket/collects/racket/contract/private/arrow-val-first.rkt
View File

@ -723,11 +723,13 @@
(set! dom-exers (cons exer dom-exers))
(set! addl-available (append ctcs addl-available)))
(define rngs-gens
(with-definitely-available-contracts
addl-available
(λ ()
(for/list ([c (in-list (base->-rngs ctc))])
(generate/choose c fuel)))))
(if (base->-rngs ctc)
(with-definitely-available-contracts
addl-available
(λ ()
(for/list ([c (in-list (base->-rngs ctc))])
(generate/choose c fuel))))
'()))
(cond
[(for/and ([rng-gen (in-list rngs-gens)])
rng-gen)
@ -787,10 +789,11 @@
(for/list ([gen (in-list gens)])
(gen))))
(λ results
(for ([res-ctc (in-list rng-ctcs)]
[result (in-list results)])
(env-stash env res-ctc result)))))
(base->-rngs ctc))]
(when rng-ctcs
(for ([res-ctc (in-list rng-ctcs)]
[result (in-list results)])
(env-stash env res-ctc result))))))
(or rng-ctcs '()))]
[else
(values void '())]))]
[else