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

Fix default contract generation and exercise proc

Browse Source 
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:
shhyou 2018-07-31 14:20:49 -05:00 committed by Robby Findler
parent 59f49cb6ff
commit aeab2420fa
2 changed files with 31 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

33
pkgs/racket-test/tests/racket/contract/random-generate.rkt
View File

@ -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

6
racket/collects/racket/contract/private/prop.rkt
View File

@ -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