Add tests for struct-type types

original commit: 892887ba71bd0bba1ea8a65195ffc4497afd2a3d
This commit is contained in:
Asumu Takikawa 2013-12-29 05:55:48 -05:00
parent 9f247a39ca
commit 55d25d738e
2 changed files with 27 additions and 0 deletions

View File

@ -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

View File

@ -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"