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

Instrument async-channel/c.

Browse Source
This commit is contained in:
Vincent St-Amour 2016-01-12 15:55:48 -06:00
parent c726cf6ffc
commit a48b559324
2 changed files with 17 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
pkgs/racket-test/tests/racket/contract/prof.rkt
View File

@ -513,4 +513,12 @@
'pos 'neg)
1))
(test/spec-passed
'contract-marks56
'(let ()
(eval '(require racket/async-channel))
(eval '(define c (contract (async-channel/c pos-blame?) (make-async-channel) 'pos 'neg)))
(eval '(async-channel-put c 3))
(eval '(async-channel-get c))))
)

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

@ -215,10 +215,17 @@
(define pos-elem-proj (lnp blame))
(define neg-elem-proj (lnp (blame-swap blame)))
(λ (val neg-party)
(define blame+neg-party (cons blame neg-party))
(check-async-channel/c ctc val blame neg-party)
(impersonate/chaperone-async-channel val
(λ (v) (pos-elem-proj v neg-party))
(λ (v) (neg-elem-proj v neg-party))
(λ (v)
(with-contract-continuation-mark
blame+neg-party
(pos-elem-proj v neg-party)))
(λ (v)
(with-contract-continuation-mark
blame+neg-party
(neg-elem-proj v neg-party)))
impersonator-prop:contracted ctc
impersonator-prop:blame blame))))