From 0d46fcb48a2865dd8bae8e229e8ffb4e3a2c9521 Mon Sep 17 00:00:00 2001
From: Sam Tobin-Hochstadt <samth@racket-lang.org>
Date: Fri, 8 Jan 2010 15:38:17 +0000
Subject: [PATCH] Create new `typed/test-engine' collection. Remove dependence
 of `typed-scheme' on `test-engine'.

svn: r17567
---
 .../typed-scheme/fail/check-expect-fail.ss    |  2 +-
 .../typed-scheme/succeed/check-expect.ss      |  2 +-
 .../typed-scheme/private/base-special-env.ss  | 34 +-------------
 collects/typed/test-engine/scheme-tests.ss    |  5 ++
 collects/typed/test-engine/type-env-ext.ss    | 47 +++++++++++++++++++
 5 files changed, 56 insertions(+), 34 deletions(-)
 create mode 100644 collects/typed/test-engine/scheme-tests.ss
 create mode 100644 collects/typed/test-engine/type-env-ext.ss

diff --git a/collects/tests/typed-scheme/fail/check-expect-fail.ss b/collects/tests/typed-scheme/fail/check-expect-fail.ss
index 92b38e8a25..7fd3ef0c99 100644
--- a/collects/tests/typed-scheme/fail/check-expect-fail.ss
+++ b/collects/tests/typed-scheme/fail/check-expect-fail.ss
@@ -1,6 +1,6 @@
 #lang typed/scheme
 
-(require test-engine/scheme-tests)
+(require typed/test-engine/scheme-tests)
 (check-expect 3 (+ 1 'foo))
 
 (test)
diff --git a/collects/tests/typed-scheme/succeed/check-expect.ss b/collects/tests/typed-scheme/succeed/check-expect.ss
index dddc43afae..2d52564c04 100644
--- a/collects/tests/typed-scheme/succeed/check-expect.ss
+++ b/collects/tests/typed-scheme/succeed/check-expect.ss
@@ -1,6 +1,6 @@
 #lang typed/scheme
 
-(require test-engine/scheme-tests)
+(require typed/test-engine/scheme-tests)
 (check-expect 3 4)
 
 (test)
diff --git a/collects/typed-scheme/private/base-special-env.ss b/collects/typed-scheme/private/base-special-env.ss
index 187da6e51d..6f41f07117 100644
--- a/collects/typed-scheme/private/base-special-env.ss
+++ b/collects/typed-scheme/private/base-special-env.ss
@@ -10,7 +10,7 @@
  (only-in scheme/match/runtime match:error)
  scheme/promise
  string-constants/string-constant
- (prefix-in ce: test-engine/scheme-tests)
+ ;(prefix-in ce: test-engine/scheme-tests)
  (for-syntax
   scheme/base syntax/parse
   (utils tc-utils)
@@ -76,37 +76,7 @@
   (-poly (a b) 
          (cl->*
           (-> (-lst a) (-val '()) (-lst a))
-          (-> (-lst a) (-lst b) (-lst (*Un a b)))))
-  [(syntax-parse (local-expand #'(ce:test) 'expression null)
-                 #:context #'ce:test
-     [(_ ce-t:id) #'ce-t])
-   (-> -Void)]
-  
-  [(syntax-parse (local-expand #'(ce:check-expect 1 1) 'module #f)
-                 #:literals (let when define-values)
-    [(define-values _ 
-       (let ((_ _))
-         (when _ 
-           (insert-test _ (lambda () (check-values-expected _ _ _ _))))))
-     #'insert-test])
-   (Univ (-> Univ) . -> . -Void)]
-  [(syntax-parse (local-expand #'(ce:check-expect 1 1) 'module #f)
-                 #:literals (let when define-values)
-                 ;#:literal-sets (kernel-literals)
-    [(define-values _ 
-       (let ((_ _))
-         (when _ 
-           (insert-test _ (lambda () (check-values-expected _ _ _ _))))))
-     #'check-values-expected])
-   ((-> Univ) Univ Univ Univ . -> . -Void)]
-  [(syntax-parse (local-expand #'(ce:check-expect 1 1) 'module #f)
-                 #:literals (let when define-values)
-                 ;#:literal-sets (kernel-literals)
-    [(define-values _ 
-       (let ((_ (nvv _ _ builder _)))
-         _))
-     #'builder])
-   (-> Univ)])
+          (-> (-lst a) (-lst b) (-lst (*Un a b))))))
      
      
      
diff --git a/collects/typed/test-engine/scheme-tests.ss b/collects/typed/test-engine/scheme-tests.ss
new file mode 100644
index 0000000000..187ffad23e
--- /dev/null
+++ b/collects/typed/test-engine/scheme-tests.ss
@@ -0,0 +1,5 @@
+#lang scheme/base
+
+(require test-engine/scheme-tests
+         "type-env-ext.ss")
+(provide (all-from-out test-engine/scheme-tests))
\ No newline at end of file
diff --git a/collects/typed/test-engine/type-env-ext.ss b/collects/typed/test-engine/type-env-ext.ss
new file mode 100644
index 0000000000..346a529f17
--- /dev/null
+++ b/collects/typed/test-engine/type-env-ext.ss
@@ -0,0 +1,47 @@
+#lang scheme/base
+
+(require typed-scheme/utils/utils
+         (prefix-in ce: test-engine/scheme-tests)
+         (for-syntax
+          scheme/base syntax/parse
+          (utils tc-utils)
+          (env init-envs)          
+          (except-in (rep filter-rep object-rep type-rep) make-arr)
+          (types convenience union)
+          (only-in (types convenience) [make-arr* make-arr])))
+
+(define-for-syntax ce-env
+  (make-env   
+   ;; test*
+   [(syntax-parse (local-expand #'(ce:test) 'expression null)
+      #:context #'ce:test
+      [(_ ce-t:id) #'ce-t])
+    (-> -Void)]   
+   ;; insert-test
+   [(syntax-parse (local-expand #'(ce:check-expect 1 1) 'module #f)
+      #:literals (let when define-values)
+      [(define-values _ 
+         (let ((_ _))
+           (when _ 
+             (insert-test _ (lambda () (check-values-expected _ _ _ _))))))
+       #'insert-test])
+    (Univ (-> Univ) . -> . -Void)]
+   ;; check-values-expected
+   [(syntax-parse (local-expand #'(ce:check-expect 1 1) 'module #f)
+      #:literals (let when define-values)
+      [(define-values _ 
+         (let ((_ _))
+           (when _ 
+             (insert-test _ (lambda () (check-values-expected _ _ _ _))))))
+       #'check-values-expected])
+    ((-> Univ) Univ Univ Univ . -> . -Void)]
+   ;; builder
+   [(syntax-parse (local-expand #'(ce:check-expect 1 1) 'module #f)
+      #:literals (let when define-values)
+      [(define-values _ 
+         (let ((_ (nvv _ _ builder _)))
+           _))
+       #'builder])
+    (-> Univ)]))
+
+(begin-for-syntax (initialize-type-env ce-env))
\ No newline at end of file