Fix polymorphic class checking.
This commit is contained in:
parent
90556817eb
commit
9aa7accd89
|
@ -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
|
||||||
|
|
|
@ -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)]
|
||||||
|
|
|
@ -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)]
|
||||||
))
|
))
|
||||||
|
|
Loading…
Reference in New Issue
Block a user