Support Any wrapping for promises
Closes PR 13326
This commit is contained in:
parent
ed00c8d70c
commit
0252207e38
14
collects/tests/typed-racket/fail/promise-any.rkt
Normal file
14
collects/tests/typed-racket/fail/promise-any.rkt
Normal file
|
@ -0,0 +1,14 @@
|
||||||
|
#;
|
||||||
|
(exn-pred exn:fail:contract?)
|
||||||
|
#lang racket
|
||||||
|
|
||||||
|
(module typed typed/racket
|
||||||
|
(: d Any)
|
||||||
|
(define d (delay (lambda: ([x : Integer]) (+ x 1))))
|
||||||
|
(provide d))
|
||||||
|
|
||||||
|
(require 'typed)
|
||||||
|
|
||||||
|
;; this line should raise a ctc error
|
||||||
|
((force d) 6)
|
||||||
|
|
19
collects/tests/typed-racket/succeed/pr13326.rkt
Normal file
19
collects/tests/typed-racket/succeed/pr13326.rkt
Normal file
|
@ -0,0 +1,19 @@
|
||||||
|
#lang racket
|
||||||
|
|
||||||
|
(require rackunit)
|
||||||
|
|
||||||
|
;; the setup here is just to make it play nice with Rackunit
|
||||||
|
(check-not-exn
|
||||||
|
(λ ()
|
||||||
|
(parameterize ([current-error-port (open-output-nowhere)])
|
||||||
|
(eval
|
||||||
|
(quote
|
||||||
|
(begin
|
||||||
|
;; This is the actual test case
|
||||||
|
(module typed typed/racket
|
||||||
|
(require typed/rackunit)
|
||||||
|
|
||||||
|
;; Any wrappings should be okay here
|
||||||
|
(check-equal? (delay 0) (delay 0)))
|
||||||
|
(require 'typed)))
|
||||||
|
(make-base-namespace)))))
|
|
@ -1,6 +1,7 @@
|
||||||
#lang racket/base
|
#lang racket/base
|
||||||
|
|
||||||
(require racket/match racket/contract/base racket/contract/combinator)
|
(require racket/match racket/contract/base racket/contract/combinator
|
||||||
|
racket/promise)
|
||||||
|
|
||||||
(define undef (letrec ([x x]) x))
|
(define undef (letrec ([x x]) x))
|
||||||
|
|
||||||
|
@ -81,6 +82,10 @@
|
||||||
(chaperone-procedure v (case-lambda [() (values)]
|
(chaperone-procedure v (case-lambda [() (values)]
|
||||||
[_ (fail v)]))
|
[_ (fail v)]))
|
||||||
(chaperone-procedure v (lambda args (fail v))))]
|
(chaperone-procedure v (lambda args (fail v))))]
|
||||||
|
[(? promise?)
|
||||||
|
;; for promises, just apply Any in the promise
|
||||||
|
(contract (promise/c any-wrap/c) v
|
||||||
|
(blame-positive b) (blame-negative b))]
|
||||||
[_ (fail v)]))
|
[_ (fail v)]))
|
||||||
t)
|
t)
|
||||||
|
|
||||||
|
|
Loading…
Reference in New Issue
Block a user