Move internal unit tests out into a separate file

pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/base-env/class-prims.rkt

@@ -45,8 +45,6 @@
   (raise-syntax-error 'class "should only be used internally"))
 
 (begin-for-syntax
- (module+ test (require rackunit))
-
  ;; forms that are not allowed by Typed Racket yet
  (define unsupported-forms
    (list (quote-syntax augride)
@@ -91,6 +89,11 @@
             (quote-syntax super-make-object)
             (quote-syntax inspect)))))
 
+;; export some syntax-time definitions for testing purposes
+(module+ internal
+  (provide (for-syntax init-decl class-clause class-clause-or-other
+                       extract-names clause init-clause get-optional-inits)))
+
 (begin-for-syntax
  ;; A Clause is a (clause Syntax Id Listof<Syntax> Option<Type>)
  ;;
@@ -293,46 +296,7 @@
    (add-kind #'init-field)
    (add-kind #'field)
    (add-kind #'public)
-   (add-kind #'pubment))
+   (add-kind #'pubment)))
- 
- (module+ test
-   ;; equal? check but considers id & stx pair equality
-   (define (equal?/id x y)
-     (cond [(and (identifier? x) (identifier? y))
-            (free-identifier=? x y)]
-           [(and (syntax? x) (syntax? y))
-            (and (free-identifier=? (stx-car x) (stx-car y))
-                 (free-identifier=? (stx-car (stx-cdr x))
-                                    (stx-car (stx-cdr y))))]
-           (equal?/recur x y equal?/id)))
-
-   ;; utility macro for checking if a syntax matches a
-   ;; given syntax class
-   (define-syntax-rule (syntax-parses? stx syntax-class)
-     (syntax-parse stx
-       [(~var _ syntax-class) #t]
-       [_ #f]))
-
-   ;; for rackunit with equal?/id
-   (define-binary-check (check-equal?/id equal?/id actual expected))
-
-   (check-true (syntax-parses? #'x init-decl))
-   (check-true (syntax-parses? #'([x y]) init-decl))
-   (check-true (syntax-parses? #'(x 0) init-decl))
-   (check-true (syntax-parses? #'([x y] 0) init-decl))
-   (check-true (syntax-parses? #'(init x y z) class-clause))
-   (check-true (syntax-parses? #'(public f g h) class-clause))
-   (check-true (syntax-parses? #'(public f) class-clause-or-other))
-   (check-equal?/id
-    (extract-names (list (clause #'(init x y z)
-                                 #'init
-                                 (list #'(x x) #'(y y) #'(z z)))
-                         (clause #'(public f g h)
-                                 #'public
-                                 (list #'(f f) #'(g g) #'(h h)))))
-    (make-immutable-free-id-table
-     (hash #'public (list #'(f f) #'(g g) #'(h h))
-           #'init (list #'(x x) #'(y y) #'(z z)))))))
 
 (define-syntax (class stx)
   (syntax-parse stx
@@ -475,13 +439,6 @@
                   #:when optional?)
          (stx-car id-pair)))))
 
-  (module+ test
-    (check-equal?/id
-     (get-optional-inits
-      (list (init-clause #'(init [x 0]) #'init #'([x x]) (list #t))
-            (init-clause #'(init [(a b)]) #'init #'([a b]) (list #f))))
-     (list #'x)))
-
   ;; check-unsupported-features : Dict<Identifier, Names> -> Void
   ;; Check if features that are not supported were used and
   ;; raise an error if they are present

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

@@ -32,4 +32,5 @@
   "keyword-expansion-test.rkt"
   "special-env-typecheck-tests.rkt"
   "contract-tests.rkt"
-  "interactive-tests.rkt")
+  "interactive-tests.rkt"
+  "class-util-tests.rkt")

pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/unit-tests/class-util-tests.rkt

@@ -0,0 +1,71 @@
+#lang racket/base
+
+;; Tests for utilities and helpers for the internals of
+;; class type-checking, parsing, etc.
+
+(require (except-in "test-utils.rkt" private)
+         racket/class
+         rackunit
+         syntax/id-table
+         syntax/parse
+         syntax/stx
+         ;; phase-shift down for use in tests below
+         (for-template (submod typed-racket/base-env/class-prims internal)))
+
+(provide tests)
+(gen-test-main)
+
+;; equal? check but considers id & stx pair equality for the
+;; specific test cases that appear here (it's not a general check)
+(define (equal?/id x y)
+  (cond [(and (identifier? x) (identifier? y))
+         (free-identifier=? x y)]
+        [(and (syntax? x) (syntax? y))
+         (and (identifier? (stx-car x))
+              (identifier? (stx-car y))
+              (free-identifier=? (stx-car x) (stx-car y))
+              (free-identifier=? (stx-car (stx-cdr x))
+                                 (stx-car (stx-cdr y))))]
+        [else (equal?/recur x y equal?/id)]))
+
+;; utility macro for checking if a syntax matches a
+;; given syntax class
+(define-syntax-rule (syntax-parses? stx syntax-class)
+  (syntax-parse stx
+    [(~var _ syntax-class) #t]
+    [_ #f]))
+
+;; for rackunit with equal?/id
+(define-binary-check (check-equal?/id equal?/id actual expected))
+
+(define tests
+  (test-suite "Class utility tests"
+    (check-true (syntax-parses? #'x init-decl))
+    (check-true (syntax-parses? #'([x y]) init-decl))
+    (check-true (syntax-parses? #'(x 0) init-decl))
+    (check-true (syntax-parses? #'([x y] 0) init-decl))
+    (check-true (syntax-parses? #'(init x y z) class-clause))
+    (check-true (syntax-parses? #'(public f g h) class-clause))
+    (check-true (syntax-parses? #'(public f) class-clause-or-other))
+
+    (check-equal?/id
+     (extract-names (list (clause #'(init x y z)
+                                  #'init
+                                  (list #'(x x) #'(y y) #'(z z))
+                                  (list #f #f #f))
+                          (clause #'(public f g h)
+                                  #'public
+                                  (list #'(f f) #'(g g) #'(h h))
+                                  (list #f #f #f))))
+     (make-immutable-free-id-table
+      (hash #'public (list #'(f f) #'(g g) #'(h h))
+            #'init (list #'(x x) #'(y y) #'(z z))))
+
+    (check-equal?/id
+     (get-optional-inits
+      (list (init-clause #'(init [x 0]) #'init #'([x x])
+                         (list #f) (list #t))
+            (init-clause #'(init [(a b)]) #'init #'([a b])
+                         (list #f) (list #f))))
+     (list #'x)))))
+