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

Exercise application result in -> contract

Browse Source
This commit is contained in:
shhyou 2018-08-03 22:13:18 -05:00 committed by Robby Findler
parent d8ea41df23
commit 33b94e6558
3 changed files with 42 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -418,3 +418,20 @@
(make-chaperone-contract
#:late-neg-projection
(λ (b) (λ (f v np) v)))))
(check-exercise
10
pos-exn?
(contract (-> integer? (-> integer? integer?))
(λ (x) (λ (y) #f))
'pos
'neg))
(check-exercise
10
pos-exn?
(contract (->i ([m integer?])
[result (-> integer? integer?)])
(λ (x) (λ (y) #f))
'pos
'neg))

22
racket/collects/racket/contract/private/arr-i.rkt
View File

@ -130,6 +130,13 @@
#:when (and (not (->i-arg-optional? arg-ctc))
(->i-arg-kwd arg-ctc)))
(->i-arg-kwd arg-ctc)))
(define rng-ctcs (map cdr (->i-rng-ctcs ctc)))
(define rng-exers
(and rng-ctcs
(for/list ([rng-ctc (in-list rng-ctcs)])
(define-values (exer ctcs)
((contract-struct-exercise rng-ctc) fuel))
exer)))
(cond
[(andmap values gens)
(define env (contract-random-generate-get-current-environment))
@ -149,13 +156,14 @@
regular-args))
(λ results
(void)
;; what to do here? (nothing, for now)
;; better: if we did actually stash the results we knew about.
'(for ([res-ctc (in-list rng-ctcs)]
[result (in-list results)])
(contract-random-generate-stash env res-ctc result)))))
;; better here: if we promised the results we knew we could deliver
'())]
(when rng-ctcs
(for ([res-ctc (in-list rng-ctcs)]
[result (in-list results)])
(contract-random-generate-stash env res-ctc result))
(for ([exer (in-list rng-exers)]
[result (in-list results)])
(exer result))))))
(or rng-ctcs '()))]
[else
(values void '())]))]
[else

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

@ -1386,6 +1386,12 @@
(define kwd-gens
(for/list ([kwd-info (in-list dom-kwd-infos)])
(contract-random-generate/choose (kwd-info-ctc kwd-info) fuel)))
(define rng-exers
(and rng-ctcs
(for/list ([rng-ctc (in-list rng-ctcs)])
(define-values (exer ctcs)
((contract-struct-exercise rng-ctc) fuel))
exer)))
(define env (contract-random-generate-get-current-environment))
(cond
[(and (andmap values gens)
@ -1405,7 +1411,10 @@
(when rng-ctcs
(for ([res-ctc (in-list rng-ctcs)]
[result (in-list results)])
(contract-random-generate-stash env res-ctc result))))))
(contract-random-generate-stash env res-ctc result))
(for ([exer (in-list rng-exers)]
[result (in-list results)])
(exer result))))))
(or rng-ctcs '()))]
[else
(values void '())]))]