Making test suite files all meet a standard interface.

All test suite files now export one identifier with the name 'tests'. This allows for them to be treated the same across the test infrastructure.
2013-10-08 22:43:54 -07:00 · 2013-10-08 22:43:54 -07:00 · 14c340a77b
commit 14c340a77b
parent 4e42a328e3
13 changed files with 55 additions and 58 deletions
--- a/pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/unit-tests/all-tests.rkt
+++ b/pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/unit-tests/all-tests.rkt
@ -1,41 +1,33 @@
-#lang scheme/base
+#lang racket/base

 (require
- "test-utils.rkt"
- "typecheck-tests.rkt" ;;pass
-
- "subtype-tests.rkt" ;; pass
- "type-equal-tests.rkt" ;; pass
- "remove-intersect-tests.rkt" ;; pass
- "parse-type-tests.rkt" ;; pass
- "subst-tests.rkt" ;; pass
- "infer-tests.rkt" ;; pass
- "type-annotation-test.rkt" ;; pass
- "keyword-expansion-test.rkt" ;;pass
- "special-env-typecheck-tests.rkt" ;;pass"
-
- "contract-tests.rkt"
- "interactive-tests.rkt"
-
- rackunit)
+ rackunit
+ (for-syntax racket/base syntax/parse racket/syntax))

 (provide unit-tests)

+(define-syntax define-tests
+  (syntax-parser
+    [(_ test-name:id files:expr ...)
+     (define/with-syntax (new-names ...)
+       (generate-temporaries #'(files ...)))
+     #'(begin
+         (require (only-in files [tests new-names]) ...)
+         (define test-name
+           (make-test-suite
+             "Unit Tests"
+             (list new-names ...))))]))

-(define unit-tests
-  (make-test-suite
-   "Unit Tests"
-   (list 
-    typecheck-special-tests
-    typecheck-tests
-    subtype-tests
-    type-equal-tests
-    restrict-tests
-    remove-tests
-    overlap-tests
-    parse-type-tests
-    type-annotation-tests
-    fv-tests
-    contract-tests
-    keyword-tests
-    interactive-tests)))
+(define-tests unit-tests
+  "typecheck-tests.rkt"
+  "subtype-tests.rkt"
+  "type-equal-tests.rkt"
+  "remove-intersect-tests.rkt"
+  "parse-type-tests.rkt"
+  "subst-tests.rkt"
+  "infer-tests.rkt"
+  "type-annotation-test.rkt"
+  "keyword-expansion-test.rkt"
+  "special-env-typecheck-tests.rkt"
+  "contract-tests.rkt"
+  "interactive-tests.rkt")
--- a/pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/unit-tests/contract-tests.rkt
+++ b/pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/unit-tests/contract-tests.rkt
@ -7,7 +7,7 @@
         (rep type-rep)
         (types abbrev numeric-tower union)
         rackunit)
-(provide contract-tests)
+(provide tests)


 (define-syntax-rule (t e)
@ -48,7 +48,7 @@



-(define contract-tests
+(define tests
  (test-suite "Contract Tests"
              known-bugs
              (t (-Number . -> . -Number))
--- a/pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/unit-tests/infer-tests.rkt
+++ b/pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/unit-tests/infer-tests.rkt
@ -4,7 +4,7 @@
         (types numeric-tower utils abbrev))


-(provide fv-tests)
+(provide tests)

 (define-syntax-rule (fv-t ty elems ...)
  (let ([ty* ty])
@ -13,7 +13,7 @@
                (fv ty*)
                (list (quote elems) ...))))

-(define fv-tests
+(define tests
  (test-suite "Tests for fv"
              (fv-t -Number)
              [fv-t (-v a) a]
--- a/pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/unit-tests/interactive-tests.rkt
+++ b/pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/unit-tests/interactive-tests.rkt
@ -10,7 +10,7 @@
    racket/format
    syntax/parse))

-(provide interactive-tests)
+(provide tests)

 (define promised-ns
  (delay
@ -42,7 +42,7 @@
                       ,(syntax->datum #'form)) (force promised-ns)))))))]))

 ;; Add 'only at the toplevel tests'
-(define interactive-tests
+(define tests
  (test-suite "Interactive tests"

    (test-form #rx""
--- a/pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/unit-tests/keyword-expansion-test.rkt
+++ b/pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/unit-tests/keyword-expansion-test.rkt
@ -5,7 +5,7 @@
         (types utils kw-types abbrev numeric-tower)
         racket/match racket/set
         rackunit)
-(provide keyword-tests)
+(provide tests)

 (define-syntax-rule (t arg expected)
  (begin
@ -37,7 +37,7 @@
 (define three (-val 'three))
 (define four (-val 'four))

-(define keyword-tests
+(define tests
  (test-suite "Tests for keyword expansion"

    [t (-> result) (-> result)]
--- a/pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/unit-tests/parse-type-tests.rkt
+++ b/pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/unit-tests/parse-type-tests.rkt
@ -12,7 +12,7 @@
         rackunit
         racket/dict)

-(provide parse-type-tests)
+(provide tests)

 ;; HORRIBLE HACK!
 ;; We are solving the following problem:
@ -73,7 +73,7 @@
 (define B -Boolean)
 (define Sym -Symbol)

-(define parse-type-tests
+(define tests
  (pt-tests
   "parse-type tests"
   [FAIL UNBOUND]
--- a/pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/unit-tests/remove-intersect-tests.rkt
+++ b/pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/unit-tests/remove-intersect-tests.rkt
@ -4,6 +4,7 @@
         (r:infer infer)
         (types abbrev numeric-tower subtype union remove-intersect)
         rackunit)
+(provide tests)

 (define-syntax (over-tests stx)
  (syntax-case stx ()
@ -66,5 +67,8 @@
   [(-pair -Number (-v a)) (-pair Univ Univ) (Un)]
   ))

-(provide remove-tests restrict-tests overlap-tests)
-
+(define tests
+  (test-suite "Remove Intersect"
+     remove-tests
+     restrict-tests
+     overlap-tests))
--- a/pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/unit-tests/special-env-typecheck-tests.rkt
+++ b/pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/unit-tests/special-env-typecheck-tests.rkt
@ -22,7 +22,7 @@
         typed-racket/base-env/prims
         typed-racket/base-env/base-types
         (for-syntax typed-racket/standard-inits))
-(provide typecheck-special-tests)
+(provide tests)

 (begin-for-syntax (do-standard-inits))

@ -41,7 +41,7 @@
         (check-tc-result-equal? (format "~a ~a" (quote-line-number id) 'a)
                                 res1 res2)))]))

-(define typecheck-special-tests
+(define tests
  (test-suite
   "Special Typechecker tests"
   ;; should work but don't -- need expected type
--- a/pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/unit-tests/subst-tests.rkt
+++ b/pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/unit-tests/subst-tests.rkt
@ -4,6 +4,7 @@
         (rep type-rep)
         (types utils abbrev numeric-tower substitute)
         rackunit)
+(provide tests)

 (define-syntax-rule (s img var tgt result)
  (test-eq? "test" (substitute img 'var tgt) result))
@ -11,7 +12,7 @@
 (define-syntax-rule (s... imgs var tgt result)
  (test-eq? "test" (substitute-dots (list . imgs) #f 'var tgt) result))

-(define subst-tests
+(define tests
  (test-suite "Tests for substitution"
              (s -Number a (-v a) -Number)
              (s... (-Number -Boolean) a (make-Function (list (make-arr-dots null -Number (-v a) 'a))) (-Number -Boolean . -> . -Number))
--- a/pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/unit-tests/subtype-tests.rkt
+++ b/pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/unit-tests/subtype-tests.rkt
@ -7,7 +7,7 @@
         rackunit
         (for-syntax scheme/base))

-(provide subtype-tests)
+(provide tests)

 (define-syntax (subtyping-tests stx)
  (define (single-test stx)
@ -26,7 +26,7 @@
 (define t1 (-mu T (-lst (Un (-v a) T))))
 (define t2 (unfold t1))

-(define subtype-tests
+(define tests
  (subtyping-tests
   ;; trivial examples
   (Univ Univ)
--- a/pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/unit-tests/type-annotation-test.rkt
+++ b/pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/unit-tests/type-annotation-test.rkt
@ -12,7 +12,7 @@

 (initialize-type-names)

-(provide type-annotation-tests)
+(provide tests)

 (define-syntax-rule (tat ann-stx ty)
  (check-tc-result-equal? (format "~a" (quote ann-stx))
@ -25,7 +25,7 @@
                                               (expand 'ann-stx))))
                          ty))

-(define type-annotation-tests
+(define tests
  (test-suite
   "Type Annotation tests"
   ;; FIXME - ask Ryan
--- a/pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/unit-tests/type-equal-tests.rkt
+++ b/pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/unit-tests/type-equal-tests.rkt
@ -5,7 +5,7 @@
         (types abbrev numeric-tower union)
         rackunit)

-(provide type-equal-tests)
+(provide tests)

 (define (-base x) (make-Base x #'dummy values #f))

@ -26,7 +26,7 @@

 (define (fld* t) (make-fld t (datum->syntax #'here 'values) #f))

-(define type-equal-tests
+(define tests
  (te-tests
   [-Number -Number]
   [(Un -Number) -Number]
--- a/pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/unit-tests/typecheck-tests.rkt
+++ b/pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/unit-tests/typecheck-tests.rkt
@ -60,7 +60,7 @@
    syntax/parse
    'tester))

-(provide typecheck-tests)
+(provide tests)


 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@ -180,7 +180,7 @@
         (make-Path p var))))


-(define typecheck-tests
+(define tests
  (test-suite
    "Typechecker tests"
    #reader typed-racket/typed-reader