Fix polymorphic class checking.

This commit is contained in:
Eric Dobson 2014-03-19 19:17:51 -07:00
parent 90556817eb
commit 9aa7accd89
3 changed files with 12 additions and 7 deletions

View File

@ -214,11 +214,10 @@
[(? Class? class-type) [(? Class? class-type)
(ret (parse-and-check form class-type))] (ret (parse-and-check form class-type))]
[(Poly-names: ns body-type) [(Poly-names: ns body-type)
;; FIXME: make sure this case is correct, does it (match (check-class form (ret body-type))
;; introduce the right names in scope? [(tc-result1: t f o)
(check-class form (ret body-type))] (ret (make-Poly ns t) f o)])]
[#f (ret (parse-and-check form #f))] [_ (ret (parse-and-check form #f))]))
[_ (check-below (ret (parse-and-check form #f)) expected)]))
;; Syntax Option<Type> -> Type ;; Syntax Option<Type> -> Type
;; Parse the syntax and extract useful information to pass to the ;; Parse the syntax and extract useful information to pass to the

View File

@ -236,8 +236,7 @@
#:literal-sets (kernel-literals tc-expr-literals) #:literal-sets (kernel-literals tc-expr-literals)
;; a TR-annotated class ;; a TR-annotated class
[stx:tr:class^ [stx:tr:class^
(check-class form expected) (check-class form expected)]
expected]
[stx:exn-handlers^ [stx:exn-handlers^
(register-ignored! form) (register-ignored! form)
(check-subforms/with-handlers/check form expected)] (check-subforms/with-handlers/check form expected)]

View File

@ -1316,4 +1316,11 @@
(define/public (m a-foo) (get-field x a-foo)))) (define/public (m a-foo) (get-field x a-foo))))
(void)) (void))
-Void] -Void]
;; test that filters are correctly handled for polymorphic classes
[tc-e (let ()
(class object%
(super-new)
(init x)))
#:ret (ret (-poly (A) (-class #:init ([x A #f]))))
#:expected (ret (-poly (A) (-class #:init ([x A #f]))) -no-filter -no-obj)]
)) ))