diff --git a/collects/tests/typed-racket/fail/control-test-1.rkt b/collects/tests/typed-racket/fail/control-test-1.rkt new file mode 100644 index 0000000000..35a73b94ec --- /dev/null +++ b/collects/tests/typed-racket/fail/control-test-1.rkt @@ -0,0 +1,28 @@ +#; +(exn-pred exn:fail:contract?) +#lang racket/load + +;; check typed-untyped interaction with continuations + +;; continuations & prompt tags +(module typed typed/racket + (provide call-f) + + (: tag (Prompt-Tag String (Integer -> String))) + (define tag (make-continuation-prompt-tag)) + + (: call-f (((Prompt-Tag String (Integer -> String)) -> String) -> String)) + (define (call-f f) + (call-with-continuation-prompt + (λ () (f tag)) + tag + (λ: ([x : Integer]) (number->string x))))) + +(module untyped racket + (require 'typed) + + (call-f + (λ (tag) + (abort-current-continuation tag "bad")))) + +(require 'untyped) \ No newline at end of file diff --git a/collects/tests/typed-racket/fail/control-test-2.rkt b/collects/tests/typed-racket/fail/control-test-2.rkt new file mode 100644 index 0000000000..ef3bc1441d --- /dev/null +++ b/collects/tests/typed-racket/fail/control-test-2.rkt @@ -0,0 +1,34 @@ +#; +(exn-pred exn:fail:contract?) +#lang racket/load + +;; check typed-untyped interaction with call/cc + +;; continuations & prompt tags +(module typed typed/racket + (provide tag call-f) + + (: tag (Prompt-Tag String (Integer -> String))) + (define tag (make-continuation-prompt-tag)) + + (: call-f (((Prompt-Tag String (Integer -> String)) -> String) -> String)) + (define (call-f f) + (call-with-continuation-prompt + (λ () (f tag)) + tag + (λ: ([x : Integer]) (number->string x))))) + +;; call/cc +(module untyped racket + (require 'typed) + + ;; construct an abortive continuation + (define (make-abort-k tag) + (call-with-continuation-prompt + (λ () (call/cc (λ (k) k) tag)) + tag)) + + (call-f + (λ (tag) ((make-abort-k tag) 'bad)))) + +(require 'untyped) \ No newline at end of file diff --git a/collects/tests/typed-racket/succeed/prompt-tag.rkt b/collects/tests/typed-racket/succeed/prompt-tag.rkt new file mode 100644 index 0000000000..458a1ef738 --- /dev/null +++ b/collects/tests/typed-racket/succeed/prompt-tag.rkt @@ -0,0 +1,22 @@ +#lang typed/racket + +(: pt (Prompt-Tag String (Integer -> Integer))) +(define pt (make-continuation-prompt-tag)) + +;; Test abort +(call-with-continuation-prompt + (λ () (string-append "foo" (abort-current-continuation pt 5))) + pt + (λ: ([x : Integer]) x)) + +(: pt2 (Prompt-Tag Integer ((Integer -> Integer) -> Integer))) +(define pt2 (make-continuation-prompt-tag)) + +;; Test call/comp & abort +(call-with-continuation-prompt + (λ () (+ 1 (call-with-composable-continuation + (λ: ([k : (Integer -> Integer)]) + (abort-current-continuation pt2 k)) + pt2))) + pt2 + (λ: ([f : (Integer -> Integer)]) (f 5))) \ No newline at end of file