Add type printer tests

original commit: 4c5e188ca411f5753bf6cfa2c0d8101b96231c0a
2014-01-07 11:16:08 -05:00 · 2014-01-07 11:16:08 -05:00 · b68b5bdd17
commit b68b5bdd17
parent e640308b0e
1 changed files with 106 additions and 0 deletions
--- a/pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/unit-tests/type-printer-tests.rkt
+++ b/pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/unit-tests/type-printer-tests.rkt
@ -0,0 +1,106 @@
+#lang racket/base
+
+;; Tests for type, filter, object, etc. printers for Typed Racket
+
+(require "test-utils.rkt"
+         rackunit
+         typed-racket/standard-inits
+         typed-racket/tc-setup
+         typed-racket/rep/type-rep
+         typed-racket/types/abbrev
+         typed-racket/types/numeric-tower
+         typed-racket/types/printer
+         typed-racket/types/union
+         typed-racket/utils/tc-utils
+         (submod typed-racket/base-env/base-types initialize))
+
+(provide tests)
+(gen-test-main)
+
+(define (prints-as? thing str)
+  (string=? (format "~a" thing) str))
+
+(define (pretty-prints-as? thing str)
+  (string=? (pretty-format-type thing) str))
+
+(define-binary-check (check-prints-as? prints-as? actual expected))
+(define-binary-check (check-pretty-prints-as? pretty-prints-as? actual expected))
+
+(do-standard-inits)
+
+(define tests
+  (test-suite
+   "Printing tests"
+   (test-suite
+    "Type printing tests"
+    (check-prints-as? (-val 3) "3")
+    (check-prints-as? (-val 'a) "'a")
+    (check-prints-as? (-val #\a) "#\\a")
+    (check-prints-as? Univ "Any")
+    (check-prints-as? (Un (-val #t) (-val #f)) "Boolean")
+    (check-prints-as? (-lst -Nat) "(Listof Nonnegative-Integer)")
+    (check-prints-as? (make-App (-poly (a) (-lst a)) (list -Nat) #'foo)
+                      "(Listof Nonnegative-Integer)")
+    (check-prints-as? (make-Mu 'x (Un (-val '()) (-pair -Nat (make-F 'x))))
+                      "(Listof Nonnegative-Integer)")
+    (check-prints-as? (-lst* -String -Symbol) "(List String Symbol)")
+    (check-prints-as? -Custodian "Custodian")
+    (check-prints-as? (make-Opaque #'integer?) "(Opaque integer?)")
+    (check-prints-as? (make-Vector -Nat) "(Vectorof Nonnegative-Integer)")
+    (check-prints-as? (make-HeterogeneousVector (list -Symbol -String))
+                      "(Vector Symbol String)")
+    (check-prints-as? (-box (-val 3)) "(Boxof 3)")
+    (check-prints-as? (make-Future -Void) "(Futureof Void)")
+    (check-prints-as? (-> -String -Void) "(String -> Void)")
+    (check-prints-as? (Un -String -Void) "(U String Void)")
+    (check-prints-as? (-pair -String -Void) "(Pairof String Void)")
+    (check-prints-as? (make-ListDots -Boolean 'x) "(List Boolean ... x)")
+    (check-prints-as? (make-F 'X) "X")
+    (check-prints-as? (make-Values (list -String -Symbol))
+                      "(values String Symbol)")
+    (check-prints-as? (make-ValuesDots (list -String -Symbol) (make-F 'x) 'x)
+                      "(values String Symbol x ... x)")
+    (check-prints-as? (-polydots (a b) (->... (list a) (b b) a))
+                      "(All (a b ...) (a b ... b -> a))")
+    (check-prints-as? (-mu x (-lst x)) "(Rec x (Listof x))")
+    (check-prints-as? (-seq -String -Symbol) "(Sequenceof String Symbol)")
+    (check-prints-as? (-poly (a) (-> a -Void)) "(All (a) (a -> Void))")
+    (check-prints-as? (->key Univ -Pathlike
+                             #:exists
+                             (one-of/c 'error 'append 'update 'replace
+                                       'truncate 'truncate/replace)
+                             #f
+                             #:mode
+                             (one-of/c 'binary 'text)
+                             #f
+                             -Void)
+                      (string-append "(Any Path-String [#:exists (U 'error"
+                                     " 'append 'update 'replace 'truncate"
+                                     " 'truncate/replace)] [#:mode (U"
+                                     " 'binary 'text)] -> Void)")))
+   (test-suite
+    "Pretty printing tests"
+    (check-pretty-prints-as? (-val 3) "3")
+    (check-pretty-prints-as? (-val 'a) "'a")
+    (check-pretty-prints-as? (-val #\a) "#\\a")
+    (check-pretty-prints-as? Univ "Any")
+    (check-pretty-prints-as? (Un (-val #t) (-val #f)) "Boolean")
+    (check-pretty-prints-as? (-lst -Nat) "(Listof Nonnegative-Integer)")
+    (check-pretty-prints-as?
+     (-polydots (c a b)
+       (cl->*
+        (-> (-> a c) (-pair a (-lst a)) (-pair c (-lst c)))
+        ((list
+          ((list a) (b b) . ->... . c)
+          (-lst a))
+         ((-lst b) b) . ->... .(-lst c))))
+     (string-append "(All (c a b ...)\n"
+                    "  (case->\n"
+                    "   ((a -> c) (Pairof a (Listof a)) -> (Pairof c (Listof c)))\n"
+                    "   ((a b ... b -> c) (Listof a) (Listof b) ... b -> (Listof c))))"))
+    (check-pretty-prints-as?
+     (-poly (a) (cl->* (-> (-Syntax a) Univ Univ (-Syntax a))
+                       (-> (-Syntax Univ) Univ Univ)))
+     (string-append "(All (a)\n"
+                    "  (case-> ((Syntaxof a) Any Any -> (Syntaxof a)) ((Syntaxof Any) Any -> Any)))")))))
+