From fec01c3f971570eb97bf0b0b72704736ea0b727c Mon Sep 17 00:00:00 2001
From: Asumu Takikawa <asumu@ccs.neu.edu>
Date: Fri, 30 Nov 2012 14:10:20 -0500
Subject: [PATCH] Add more tests for continuation marks & Any wrapping

original commit: a42cc9a0012cb7490da13228d21b2182fb1af9d3
---
 .../typed-racket/fail/control-test-4.rkt      | 29 +++++++++++++++++++
 .../typed-racket/fail/control-test-5.rkt      | 28 ++++++++++++++++++
 .../typed-racket/fail/control-test-6.rkt      | 27 +++++++++++++++++
 .../succeed/continuation-mark.rkt             | 24 +++++++++++++++
 4 files changed, 108 insertions(+)
 create mode 100644 collects/tests/typed-racket/fail/control-test-4.rkt
 create mode 100644 collects/tests/typed-racket/fail/control-test-5.rkt
 create mode 100644 collects/tests/typed-racket/fail/control-test-6.rkt
 create mode 100644 collects/tests/typed-racket/succeed/continuation-mark.rkt

diff --git a/collects/tests/typed-racket/fail/control-test-4.rkt b/collects/tests/typed-racket/fail/control-test-4.rkt
new file mode 100644
index 00000000..1f3a50ad
--- /dev/null
+++ b/collects/tests/typed-racket/fail/control-test-4.rkt
@@ -0,0 +1,29 @@
+#;
+(exn-pred exn:fail:contract?)
+#lang racket/load
+
+;; check typed-untyped interaction with cont marks
+
+(module typed typed/racket
+  (provide call-f)
+
+  (: key (Continuation-Mark-Keyof (Integer -> String)))
+  (define key (make-continuation-mark-key))
+
+  (: call-f (((Continuation-Mark-Keyof (Integer -> String)) -> String)
+             -> String))
+  (define (call-f f)
+    (with-continuation-mark
+     key (λ (n) (number->string n))
+     (f key))))
+
+(module untyped racket
+  (require 'typed)
+
+  (call-f
+   (λ (key)
+     (string-append "hello "
+                    ((continuation-mark-set-first #f key) 'bad)))))
+
+(require 'untyped)
+
diff --git a/collects/tests/typed-racket/fail/control-test-5.rkt b/collects/tests/typed-racket/fail/control-test-5.rkt
new file mode 100644
index 00000000..7603f943
--- /dev/null
+++ b/collects/tests/typed-racket/fail/control-test-5.rkt
@@ -0,0 +1,28 @@
+#;
+(exn-pred exn:fail:contract?)
+#lang racket/load
+
+;; check typed-untyped interaction with cont marks
+
+(module typed typed/racket
+  (provide key f)
+
+  (: key (Continuation-Mark-Keyof String))
+  (define key (make-continuation-mark-key))
+
+  (: f (-> String))
+  (define (f)
+    (apply string-append
+           (continuation-mark-set->list
+            (current-continuation-marks)
+            key))))
+
+(module untyped racket
+  (require 'typed)
+
+  (with-continuation-mark
+   key 'hello ; should be string
+   (f)))
+
+(require 'untyped)
+
diff --git a/collects/tests/typed-racket/fail/control-test-6.rkt b/collects/tests/typed-racket/fail/control-test-6.rkt
new file mode 100644
index 00000000..4043b839
--- /dev/null
+++ b/collects/tests/typed-racket/fail/control-test-6.rkt
@@ -0,0 +1,27 @@
+#;
+(exn-pred exn:fail:contract?)
+#lang racket/load
+
+;; check Any wrapper for default-continuation-prompt-tag
+
+(module typed typed/racket
+  (provide f)
+
+  (: f (-> Void))
+  (define (f)
+    (abort-current-continuation
+     (default-continuation-prompt-tag)
+     (λ: ([x : Number]) (+ 1 x)))))
+
+(module untyped racket
+  (require 'typed)
+
+  (call-with-continuation-prompt
+   (λ () (f))
+   (default-continuation-prompt-tag)
+   ;; behavioral values are not allowed to pass
+   ;; through the Any contract to here
+   (λ (f) (f 3))))
+
+(require 'untyped)
+
diff --git a/collects/tests/typed-racket/succeed/continuation-mark.rkt b/collects/tests/typed-racket/succeed/continuation-mark.rkt
new file mode 100644
index 00000000..fbf96bfa
--- /dev/null
+++ b/collects/tests/typed-racket/succeed/continuation-mark.rkt
@@ -0,0 +1,24 @@
+#lang racket/load
+
+;; successful typed-untyped interaction with cont marks
+
+(module typed typed/racket
+  (provide call-f)
+
+  (: key (Continuation-Mark-Keyof String))
+  (define key (make-continuation-mark-key))
+
+  (: call-f (((Continuation-Mark-Keyof String) -> String) -> String))
+  (define (call-f f)
+    (with-continuation-mark key "hello" (f key))))
+
+(module untyped racket
+  (require 'typed)
+
+  (call-f
+   (λ (key)
+     (string-append (continuation-mark-set-first #f key)
+                    " world"))))
+
+(require 'untyped)
+