Add new tests.

Fix old tests for new Struct datatype.

svn: r10161

collects/tests/typed-scheme/succeed/int-def-colon.ss

@@ -0,0 +1,10 @@
+#lang typed-scheme
+
+(define-type-alias Int Integer)
+
+(: foo (Int -> Int))
+(define (foo)
+ (: loop (Int -> Int))
+ (define (loop x)
+   (loop x))
+ (loop 0))

collects/tests/typed-scheme/succeed/module-lang.ss

@@ -0,0 +1,18 @@
+#lang scheme/load
+
+(module m typed-scheme
+  (: f (All (a) (a -> a)))
+  (define (f x) x)
+  (provide f))
+
+(module n typed-scheme
+  (require 'm))
+
+(require typed-scheme)
+
+(require 'n)
+
+(current-namespace (module->namespace ''n))
+
+(f 1)
+

collects/tests/typed-scheme/succeed/provide-struct.ss

@@ -0,0 +1,16 @@
+#lang scheme/load 
+
+
+(module m typed-scheme
+  (define-typed-struct A ())
+  (define-typed-struct (x A) ([y : Number] [z : Boolean]))
+  (: foo (x -> Number))
+  (define (foo z) 1)
+  (provide (all-defined-out)))
+
+(module n scheme
+  (require (prefix-in m: 'm))
+  (m:foo (m:make-x 1 #f))
+  m:x?)
+
+(require 'n)

collects/tests/typed-scheme/succeed/require-poly.ss

@@ -0,0 +1,3 @@
+#lang typed-scheme
+
+(require "simple-poly.ss")

collects/tests/typed-scheme/succeed/simple-poly.ss

@@ -0,0 +1,5 @@
+(module simple-poly typed-scheme
+  (: f (All (a) (a -> a)))
+  (define (f x) x)
+  (define: z : Any 2)
+  (provide f))

collects/tests/typed-scheme/succeed/struct-cert.ss

@@ -0,0 +1,16 @@
+#lang scheme/load
+
+(module for-broken typed-scheme
+  
+  (define-typed-struct type ())
+   
+  (provide (all-defined-out)))
+
+(module broken typed-scheme
+  
+  (require (prefix-in t: 'for-broken))
+  (define-typed-struct binding  ([type : t:type]))
+  ;; Comment out the below and it works fine.
+  (provide (all-defined-out)))
+
+(require 'broken)

collects/tests/typed-scheme/unit-tests/subtype-tests.ss

@@ -110,10 +110,10 @@
     (cl-> [() (-pair N (-v b))]
 	  [(N) (-pair N (-v b))])]
    
-   [(-poly (a) ((Un (-base 'foo) (-struct 'bar #f (list N a) #f)) . -> . (-lst a)))
-    ((Un (-base 'foo) (-struct 'bar #f (list N (-pair N (-v a))) #f)) . -> . (-lst (-pair N (-v a))))]
-   [(-poly (a) ((-struct 'bar #f (list N a) #f) . -> . (-lst a)))
-    ((-struct 'bar #f (list N (-pair N (-v a))) #f) . -> . (-lst (-pair N (-v a))))]
+   [(-poly (a) ((Un (-base 'foo) (-struct 'bar #f (list N a) #f #f #f values)) . -> . (-lst a)))
+    ((Un (-base 'foo) (-struct 'bar #f (list N (-pair N (-v a))) #f #f #f values)) . -> . (-lst (-pair N (-v a))))]
+   [(-poly (a) ((-struct 'bar #f (list N a) #f #f #f values) . -> . (-lst a)))
+    ((-struct 'bar #f (list N (-pair N (-v a))) #f #f #f values) . -> . (-lst (-pair N (-v a))))]
    
    [(-poly (a) (a . -> . (make-Listof a))) ((-v b) . -> . (make-Listof (-v b)))]
    [(-poly (a) (a . -> . (make-Listof a))) ((-pair N (-v b)) . -> . (make-Listof (-pair N (-v b))))]

collects/tests/typed-scheme/unit-tests/type-equal-tests.ss

@@ -33,9 +33,11 @@
    [(-poly (x) (-> (Un Sym N) x)) (-poly (xyz) (-> (Un N Sym) xyz))]
    [(-mu x (Un N Sym x)) (-mu y (Un N Sym y))]     
    ;; found bug
-   [FAIL (Un (-mu heap-node (-struct 'heap-node #f (list (-base 'comparator) N (-v a) (Un heap-node (-base 'heap-empty))) #f)) 
+   [FAIL (Un (-mu heap-node 
+                  (-struct 'heap-node #f (list (-base 'comparator) N (-v a) (Un heap-node (-base 'heap-empty))) #f  #f #f values)) 
              (-base 'heap-empty))
-         (Un (-mu heap-node (-struct 'heap-node #f (list (-base 'comparator) N (-pair N N) (Un heap-node (-base 'heap-empty))) #f)) 
+         (Un (-mu heap-node 
+                  (-struct 'heap-node #f (list (-base 'comparator) N (-pair N N) (Un heap-node (-base 'heap-empty))) #f #f #f values)) 
              (-base 'heap-empty))]))