From 55d25d738e33abd6f77c729ee038adfc529e70fc Mon Sep 17 00:00:00 2001 From: Asumu Takikawa Date: Sun, 29 Dec 2013 05:55:48 -0500 Subject: [PATCH] Add tests for struct-type types original commit: 892887ba71bd0bba1ea8a65195ffc4497afd2a3d --- .../unit-tests/parse-type-tests.rkt | 6 ++++++ .../unit-tests/typecheck-tests.rkt | 21 +++++++++++++++++++ 2 files changed, 27 insertions(+) diff --git 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 index d4fc2723..f4654f97 100644 --- 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 @@ -127,6 +127,12 @@ [(Opaque foo?) (make-Opaque #'foo?)] ;; PR 14122 [FAIL (Opaque 3)] + + ;; struct types + [(Struct-Type arity-at-least) (make-StructType (resolve -Arity-At-Least))] + [FAIL (Struct-Type Integer)] + [FAIL (Struct-Type foo)] + [Struct-TypeTop (make-StructTypeTop)] )) ;; FIXME - add tests for parse-values-type, parse-tc-results diff --git 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 index 5f1bc855..edba94dc 100644 --- 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 @@ -1893,6 +1893,27 @@ [tc-e (vector-memq 3 #(a b c)) (t:Un (-val #f) -Index)] [tc-e (vector-memv 3 #(a b c)) (t:Un (-val #f) -Index)] [tc-e (vector-member 3 #(a b c)) (t:Un (-val #f) -Index)] + + ;; tests for struct type types + [tc-e (let-values ([(_1 _2 _3 _4 _5 _6 parent _7) + (struct-type-info + (let-values ([(type _1 _2 _3 _4) + (make-struct-type 'foo #f 3 0)]) + type))]) + parent) + (-opt (make-StructTypeTop))] + [tc-e (let-values ([(name _1 _2 getter setter _3 _4 _5) + (struct-type-info struct:arity-at-least)]) + (getter (arity-at-least 3) 0)) + Univ] + [tc-e (assert (let-values ([(type _) (struct-info (arity-at-least 3))]) + type)) + (make-StructTypeTop)] + [tc-err (let-values ([(name _1 _2 getter setter _3 _4 _5) + (struct-type-info struct:arity-at-least)]) + (getter 'bad 0))] + [tc-err (struct-type-make-constructor 'bad)] + [tc-err (struct-type-make-predicate 'bad)] ) (test-suite "tc-literal tests"