Add start of type->contract test suite.

Add test for poly annotation failure.

svn: r14809

original commit: b30338e0c55fcef33a43a844d963ad8cdcee998b

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

@@ -12,6 +12,7 @@
  "module-tests.ss" ;; pass
  "subst-tests.ss" ;; pass
  "infer-tests.ss" ;; pass
+ "contract-tests.ss"
  )
 
 (require (r:infer infer infer-dummy)
@@ -35,7 +36,8 @@
                   parse-type-tests
                   type-annotation-tests
                   module-tests
-                  fv-tests)])
+                  fv-tests
+                  contract-tests)])
      (f))))
 
 

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

@@ -0,0 +1,21 @@
+#lang scheme/base
+
+(require "test-utils.ss" "planet-requires.ss"
+         (for-syntax scheme/base)
+         (for-template scheme/base)
+         (private type-contract)	 
+	 (rep type-rep filter-rep object-rep)
+         (types utils union convenience)
+         (utils tc-utils mutated-vars)
+         (schemeunit)
+         stxclass)
+
+(define-syntax-rule (t e)
+  (test-not-exn (format "~a" e) (lambda () (type->contract e (lambda _ (error "type could not be converted to contract"))))))
+
+(define (contract-tests)
+  (test-suite "Contract Tests"
+              (t (-Number . -> . -Number))))
+
+(define-go contract-tests)
+(provide contract-tests)

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

@@ -714,6 +714,9 @@
         [tc-e (assq 'foo #{'((a b) (foo bar)) :: (Listof (List Symbol Symbol))})
               (Un (-val #f) (-pair Sym (-pair Sym (-val null))))]
         
+        [tc-e/t (ann (lambda (x) x) (All (a) (a -> a)))
+                (-poly (a) (a . -> . a))]
+        
         #;[tc-err (let: ([fact : (Number -> Number) (lambda: ([n : Number]) (if (zero? n) 1 (* n (fact (- n 1)))))])
                         (fact 20))]