Fix default contract generation and exercise proc
The default values updated in commit ffc5720b5
do
not work for very subtle reasons. In build-contract
in racket/contract/private/prop, the default values
should not accept an extra ctc argument since ctc
is already handled by make-flat-contract. The
default gen procedure should also be (λ (fuel) #f)
instead of (λ (ctc) (λ () #f)) since the latter
would generate false when the generation should
have failed. In build-property, the default procedure
(λ (ctc) (λ (fuel) #f)) is correct and should not
be changed to (λ (ctc) (λ () #f)).
This commit is contained in:
parent
59f49cb6ff
commit
aeab2420fa
|
@ -413,11 +413,34 @@
|
|||
(check-exercise 2 void? even-list/c)
|
||||
(check-exercise 2 void? even-list/c/generate))
|
||||
|
||||
(check-false
|
||||
(contract-random-generate
|
||||
(make-chaperone-contract
|
||||
#:late-neg-projection
|
||||
(λ (b) (λ (f v np) v)))))
|
||||
(let () ;; test the default value of generate / exercise for make-chaperone-contract
|
||||
(define custom-any/c
|
||||
(make-chaperone-contract
|
||||
#:late-neg-projection
|
||||
(λ (b) (λ (v np) v))))
|
||||
(define any->any/c
|
||||
(make-chaperone-contract
|
||||
#:late-neg-projection
|
||||
(λ (b)
|
||||
(λ (v np)
|
||||
(chaperone-procedure v values impersonator-prop:contracted any->any/c)))))
|
||||
(define/contract proc any->any/c values)
|
||||
(check-exn cannot-generate-exn? (λ () (test-contract-generation custom-any/c)))
|
||||
(check-not-exn (λ () (contract-exercise proc))))
|
||||
|
||||
(let ()
|
||||
(struct impersonate-any/c-struct ()
|
||||
#:property prop:contract
|
||||
(build-contract-property
|
||||
#:late-neg-projection
|
||||
(λ (ctc) (λ (b) (λ (v np) v)))))
|
||||
(define impersonate-any/c (impersonate-any/c-struct))
|
||||
(check-exn cannot-generate-exn? (λ () (test-contract-generation impersonate-any/c)))
|
||||
(check-exn cannot-generate-exn?
|
||||
(λ ()
|
||||
(test-contract-generation
|
||||
(->i ([n integer?])
|
||||
[_ (n) (λ (r) (eq? r (even? n)))])))))
|
||||
|
||||
(check-exercise
|
||||
10
|
||||
|
|
|
@ -298,7 +298,7 @@
|
|||
#:late-neg-projection [get-late-neg-projection #f]
|
||||
#:stronger [stronger #f]
|
||||
#:equivalent [equivalent #f]
|
||||
#:generate [generate (λ (ctc) (λ () #f))]
|
||||
#:generate [generate (λ (ctc) (λ (fuel) #f))]
|
||||
#:exercise [exercise (λ (ctc) (λ (fuel) (values void '())))]
|
||||
#:list-contract? [list-contract? (λ (c) #f)])
|
||||
(unless (or get-first-order
|
||||
|
@ -476,8 +476,8 @@
|
|||
#:late-neg-projection [late-neg-projection #f]
|
||||
#:stronger [stronger #f]
|
||||
#:equivalent [equivalent #f]
|
||||
#:generate [generate (λ (ctc) (λ () #f))]
|
||||
#:exercise [exercise (λ (ctc) (λ (fuel) (values void '())))]
|
||||
#:generate [generate (λ (fuel) #f)]
|
||||
#:exercise [exercise (λ (fuel) (values void '()))]
|
||||
#:list-contract? [list-contract? #f])
|
||||
|
||||
(unless (or first-order
|
||||
|
|
Loading…
Reference in New Issue
Block a user