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

Fix the first order check on async-channel/c

Browse Source
This commit is contained in:
Alexis King 2015-05-21 09:04:32 -07:00 committed by Robby Findler
parent 0bed8e8928
commit 391a672bf6
2 changed files with 11 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
pkgs/racket-test/tests/racket/contract/async-channel.rkt
View File

@ -23,4 +23,11 @@
'(let ([ac (contract (async-channel/c (cons/c (-> boolean? boolean?) '())) '(let ([ac (contract (async-channel/c (cons/c (-> boolean? boolean?) '()))
(make-async-channel) 'pos 'neg)]) (make-async-channel) 'pos 'neg)])
(async-channel-put ac (list values)) (async-channel-put ac (list values))
((car (async-channel-get ac)) 3)))) ((car (async-channel-get ac)) 3)))
(test/spec-passed
'async-channel/c-with-higher-order
'(let ([ac (contract (or/c (async-channel/c integer?) (integer? . -> . integer?))
(make-async-channel) 'pos 'neg)])
(async-channel-put ac 1)
(async-channel-get ac))))

8
racket/collects/racket/async-channel.rkt
View File

@ -209,9 +209,7 @@
val '(expected "an async channel" given: "~e") val)))) val '(expected "an async channel" given: "~e") val))))
(define ((async-channel/c-first-order ctc) val) (define ((async-channel/c-first-order ctc) val)
(define elem-ctc (base-async-channel/c-content ctc)) (async-channel? val))
(and (async-channel? val)
(contract-first-order-passes? elem-ctc val)))
(define (async-channel/c-stronger? a b) (define (async-channel/c-stronger? a b)
(contract-stronger? (base-async-channel/c-content a) (base-async-channel/c-content b))) (contract-stronger? (base-async-channel/c-content a) (base-async-channel/c-content b)))
@ -251,7 +249,7 @@
#:property prop:chaperone-contract #:property prop:chaperone-contract
(build-chaperone-contract-property (build-chaperone-contract-property
#:name async-channel/c-name #:name async-channel/c-name
#:first-order async-channel? #:first-order async-channel/c-first-order
#:stronger async-channel/c-stronger? #:stronger async-channel/c-stronger?
#:val-first-projection (ho-val-first-projection chaperone-async-channel) #:val-first-projection (ho-val-first-projection chaperone-async-channel)
#:projection (ho-projection chaperone-async-channel))) #:projection (ho-projection chaperone-async-channel)))
@ -261,7 +259,7 @@
#:property prop:contract #:property prop:contract
(build-contract-property (build-contract-property
#:name async-channel/c-name #:name async-channel/c-name
#:first-order async-channel? #:first-order async-channel/c-first-order
#:stronger async-channel/c-stronger? #:stronger async-channel/c-stronger?
#:val-first-projection (ho-val-first-projection impersonate-async-channel) #:val-first-projection (ho-val-first-projection impersonate-async-channel)
#:projection (ho-projection impersonate-async-channel))) #:projection (ho-projection impersonate-async-channel)))