Moved static-contract tests to TR test directory.

pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/static-contracts/optimize.rkt

@@ -67,89 +67,3 @@
   ((recur variance) sc 'covariant))
 
 
-(module+ test
-  (require rackunit)
-  (provide optimizer-tests)
-  (define-check (check-optimize variance* argument* expected*)
-    (let ([variance variance*]
-          [argument argument*]
-          [expected expected*])
-      (with-check-info*
-        (list (make-check-info 'original argument)
-              (make-check-expected expected))
-        (lambda ()
-          (let  ([opt (optimize argument variance)])
-            (with-check-info* (list (make-check-actual opt))
-              (lambda ()
-                (unless (equal? opt expected)
-                  (fail-check)))))))))
-
-
-  (define optimizer-tests
-    (test-suite "Optimizer Tests"
-      (check-optimize 'covariant
-        (listof/sc any/sc)
-        any/sc)
-      (check-optimize 'contravariant
-        (listof/sc any/sc)
-        list?/sc)
-      (check-optimize 'covariant
-        (set/sc any/sc)
-        any/sc)
-      (check-optimize 'contravariant
-        (set/sc any/sc)
-        set?/sc)
-      (check-optimize 'covariant
-        (function/sc (list (listof/sc any/sc))
-                     (list)
-                     (list)
-                     (list)
-                     #f
-                     (list (listof/sc any/sc)))
-        (function/sc (list list?/sc)
-                     (list)
-                     (list)
-                     (list)
-                     #f
-                     #f))
-      (check-optimize 'contravariant
-        (function/sc (list (listof/sc any/sc))
-                     (list)
-                     (list)
-                     (list)
-                     #f
-                     (list (listof/sc any/sc)))
-        (function/sc (list any/sc)
-                     (list)
-                     (list)
-                     (list)
-                     #f
-                     (list list?/sc)))
-      (check-optimize 'contravariant
-        (function/sc (list (listof/sc any/sc))
-                     (list)
-                     (list)
-                     (list)
-                     #f
-                     (list any/sc))
-        (function/sc (list any/sc)
-                     (list)
-                     (list)
-                     (list)
-                     #f
-                     (list any/sc)))
-      (check-optimize 'covariant
-        (case->/sc empty)
-        (case->/sc empty))
-      (check-optimize 'contravariant
-        (case->/sc empty)
-        (case->/sc empty))
-      (check-optimize 'covariant
-        (parameter/sc list?/sc (flat/sc #'symbol?))
-        (parameter/sc list?/sc any/sc))
-      (check-optimize 'contravariant
-        (case->/sc (list (arr/sc (list (listof/sc any/sc)) (listof/sc (set/sc any/sc)) (list (listof/sc any/sc)))))
-        (case->/sc (list (arr/sc (list any/sc) any/sc (list list?/sc)))))
-      (check-optimize 'covariant
-        (case->/sc (list (arr/sc (list (listof/sc any/sc)) (listof/sc (set/sc any/sc)) (list (listof/sc any/sc)))))
-        (case->/sc (list (arr/sc (list list?/sc) (listof/sc set?/sc) #f)))))))

pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/static-contracts/tests.rkt

@@ -1,71 +0,0 @@
-#lang scheme/base
-
-(require tests/typed-racket/unit-tests/test-utils
-         (for-syntax scheme/base)
-         (for-template scheme/base)
-         (types abbrev numeric-tower union)
-         rackunit
-         "types.rkt" "instantiate.rkt")
-
-(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-namespace-anchor anchor)
-(define ns (namespace-anchor->empty-namespace anchor))
-
-(define-syntax-rule (t/sc e)
-  (test-case (format "~a" e)
-    (define sc
-       (type->static-contract e (lambda _ (error "type could not be converted to static-contract"))))
-    (with-check-info (['static-contract sc])
-      (define ctc (instantiate sc (lambda _ (error "static-contract could not be converted to a contract"))))
-      (with-check-info (['contract (syntax->datum ctc)])
-        (eval-syntax ctc ns)))))
-
-(define-syntax-rule (t/fail e)
-  (test-not-exn (format "~a" e) (lambda ()
-                                  (let/ec exit
-                                    (type->static-contract e (lambda _ (exit #t)))
-                                    (error "type could be converted to contract")))))
-
-(define-syntax-rule (t/fail-import e)
-  (test-not-exn (format "~a" e) (lambda ()
-                                  (let/ec exit
-                                    (type->static-contract e (lambda _ (exit #t)) #:typed-side #f)
-                                    (error "type could be converted to contract")))))
-
-
-(define contract-tests
-  (test-suite "Contract Tests"
-              (t/sc (-Number . -> . -Number))
-              (t/sc (cl->* (-> -Symbol)
-                           (-Symbol . -> . -Symbol)))
-              (t/sc (cl->* (-> -Symbol)
-                           (-Symbol -Symbol . -> . -Symbol)))
-              (t/sc (cl->* (-Symbol . -> . -Symbol)
-                           (-Symbol -Symbol . -> . -Symbol)))
-              (t/sc (-Promise -Number))
-              (t/sc (-lst -Symbol))
-              (t/sc -Boolean)
-              (t/sc Univ)
-              (t/sc (-set Univ))
-              (t/sc (-poly (a) (-lst a)))
-              (t/fail ((-poly (a) (-vec a)) . -> . -Symbol))
-              (t/fail-import (-poly (a) (-lst a)))
-              (t/sc (-mu a (-lst a)))
-              (t/sc (-mu a (-box a)))
-              (t/sc (-mu sexp (Un (-val '()) -Symbol (-pair sexp sexp) (-vec sexp) (-box sexp))))
-              (t/sc (-mu a (-> a a)))
-              (t/sc (-seq -Symbol))
-              ))
-
-
-(require (submod "optimize.rkt" test))
-(define all-tests
-  (test-suite "All Tests"
-    contract-tests
-    optimizer-tests))
-
-(require rackunit/text-ui)
-(void (run-tests all-tests))
-

pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/utils/utils.rkt

@@ -17,7 +17,7 @@ at least theoretically.
  ;; logging
  show-input?
  ;; provide macros
- rep utils typecheck infer env private types)
+ rep utils typecheck infer env private types static-contracts)
 
 (define optimize? (make-parameter #t))
 (define-for-syntax enable-contracts? #f)

pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/unit-tests/all-tests.rkt

@@ -23,6 +23,8 @@
   "subtype-tests.rkt"
   "type-equal-tests.rkt"
   "remove-intersect-tests.rkt"
+  "static-contract-conversion-tests.rkt"
+  "static-contract-optimizer-tests.rkt"
   "parse-type-tests.rkt"
   "subst-tests.rkt"
   "infer-tests.rkt"

pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/unit-tests/static-contract-conversion-tests.rkt

@@ -0,0 +1,71 @@
+#lang racket/base
+
+(require "test-utils.rkt" "evaluator.rkt"
+         rackunit
+         (only-in racket/contract contract?)
+         syntax/srcloc syntax/location
+         (for-syntax
+           syntax/parse
+           racket/base
+           (static-contracts types instantiate)
+           (types abbrev numeric-tower union)))
+
+(provide tests)
+(gen-test-main)
+
+(define-syntax t/sc
+  (syntax-parser
+    [(_ e:expr)
+     (syntax/loc #'e
+       (test-case
+         (format "Conversion:~a" (quote-line-number e))
+         (with-check-info (['type 'e]
+                           ['location (build-source-location-list (quote-srcloc e))])
+           (phase1-phase0-eval
+             (define sc
+                (type->static-contract e (lambda _ #f)))
+             (if sc
+                 #`(with-check-info (['static '#,sc])
+                     (phase1-phase0-eval
+                       (define ctc (instantiate '#,sc
+                                     (lambda _ (error "static-contract could not be converted to a contract"))))
+                       #,#'#`(with-check-info (['contract '#,ctc])
+                          (define runtime-contract #,ctc)
+                          (check-pred contract? runtime-contract))))
+                 #'(fail-check "Type could not be converted to a static contract"))))))]))
+
+(define-syntax t/fail
+  (syntax-parser
+    [(_ e:expr (~optional (~seq #:typed-side typed-side) #:defaults ([typed-side #'#t])))
+     #`(test-case (format "~a" 'e)
+         (define sc
+           (phase1-phase0-eval
+             (let/ec exit
+               #`'#,(type->static-contract e (lambda _ (exit #'#f)) #:typed-side typed-side))))
+         (when sc
+           (with-check-info (['static sc])
+             (fail-check "Type was incorrectly converted to contract"))))]))
+
+
+(define tests
+  (test-suite "Conversion Tests"
+    (t/sc (-Number . -> . -Number))
+    (t/sc (cl->* (-> -Symbol)
+                 (-Symbol . -> . -Symbol)))
+    (t/sc (cl->* (-> -Symbol)
+                 (-Symbol -Symbol . -> . -Symbol)))
+    (t/sc (cl->* (-Symbol . -> . -Symbol)
+                 (-Symbol -Symbol . -> . -Symbol)))
+    (t/sc (-Promise -Number))
+    (t/sc (-lst -Symbol))
+    (t/sc -Boolean)
+    (t/sc Univ)
+    (t/sc (-set Univ))
+    (t/sc (-poly (a) (-lst a)))
+    (t/fail ((-poly (a) (-vec a)) . -> . -Symbol))
+    (t/fail (-poly (a) (-lst a)) #:typed-side #f)
+    (t/sc (-mu a (-lst a)))
+    (t/sc (-mu a (-box a)))
+    (t/sc (-mu sexp (Un (-val '()) -Symbol (-pair sexp sexp) (-vec sexp) (-box sexp))))
+    (t/sc (-mu a (-> a a)))
+    (t/sc (-seq -Symbol))))

pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/unit-tests/static-contract-optimizer-tests.rkt

@@ -0,0 +1,93 @@
+#lang racket/base
+
+(require "test-utils.rkt"
+         racket/list
+         rackunit
+         (static-contracts instantiate optimize combinators))
+
+(provide tests)
+(gen-test-main)
+
+(define-check (check-optimize variance* argument* expected*)
+  (let ([variance variance*]
+        [argument argument*]
+        [expected expected*])
+    (with-check-info*
+      (list (make-check-info 'original argument)
+            (make-check-expected expected))
+      (lambda ()
+        (let  ([opt (optimize argument variance)])
+          (with-check-info* (list (make-check-actual opt))
+            (lambda ()
+              (unless (equal? opt expected)
+                (fail-check)))))))))
+
+
+(define tests
+  (test-suite "Static Contract Optimizer Tests"
+    (check-optimize 'covariant
+      (listof/sc any/sc)
+      any/sc)
+    (check-optimize 'contravariant
+      (listof/sc any/sc)
+      list?/sc)
+    (check-optimize 'covariant
+      (set/sc any/sc)
+      any/sc)
+    (check-optimize 'contravariant
+      (set/sc any/sc)
+      set?/sc)
+    (check-optimize 'covariant
+      (function/sc (list (listof/sc any/sc))
+                   (list)
+                   (list)
+                   (list)
+                   #f
+                   (list (listof/sc any/sc)))
+      (function/sc (list list?/sc)
+                   (list)
+                   (list)
+                   (list)
+                   #f
+                   #f))
+    (check-optimize 'contravariant
+      (function/sc (list (listof/sc any/sc))
+                   (list)
+                   (list)
+                   (list)
+                   #f
+                   (list (listof/sc any/sc)))
+      (function/sc (list any/sc)
+                   (list)
+                   (list)
+                   (list)
+                   #f
+                   (list list?/sc)))
+    (check-optimize 'contravariant
+      (function/sc (list (listof/sc any/sc))
+                   (list)
+                   (list)
+                   (list)
+                   #f
+                   (list any/sc))
+      (function/sc (list any/sc)
+                   (list)
+                   (list)
+                   (list)
+                   #f
+                   (list any/sc)))
+    (check-optimize 'covariant
+      (case->/sc empty)
+      (case->/sc empty))
+    (check-optimize 'contravariant
+      (case->/sc empty)
+      (case->/sc empty))
+    (check-optimize 'covariant
+      (parameter/sc list?/sc (flat/sc #'symbol?))
+      (parameter/sc list?/sc any/sc))
+    (check-optimize 'contravariant
+      (case->/sc (list (arr/sc (list (listof/sc any/sc)) (listof/sc (set/sc any/sc)) (list (listof/sc any/sc)))))
+      (case->/sc (list (arr/sc (list any/sc) any/sc (list list?/sc)))))
+    (check-optimize 'covariant
+      (case->/sc (list (arr/sc (list (listof/sc any/sc)) (listof/sc (set/sc any/sc)) (list (listof/sc any/sc)))))
+      (case->/sc (list (arr/sc (list list?/sc) (listof/sc set?/sc) #f))))))

pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/unit-tests/test-utils.rkt

@@ -9,7 +9,7 @@
          (rep type-rep)
          rackunit rackunit/text-ui)
 
-(provide private typecheck (rename-out [infer r:infer]) utils env rep types base-env
+(provide private typecheck (rename-out [infer r:infer]) utils env rep types base-env static-contracts
          (all-defined-out))
 
 ;; FIXME - do something more intelligent