diff --git a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/check-class-unit.rkt b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/check-class-unit.rkt index fde4401789..cd7dd8be39 100644 --- a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/check-class-unit.rkt +++ b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/check-class-unit.rkt @@ -214,11 +214,10 @@ [(? Class? class-type) (ret (parse-and-check form class-type))] [(Poly-names: ns body-type) - ;; FIXME: make sure this case is correct, does it - ;; introduce the right names in scope? - (check-class form (ret body-type))] - [#f (ret (parse-and-check form #f))] - [_ (check-below (ret (parse-and-check form #f)) expected)])) + (match (check-class form (ret body-type)) + [(tc-result1: t f o) + (ret (make-Poly ns t) f o)])] + [_ (ret (parse-and-check form #f))])) ;; Syntax Option -> Type ;; Parse the syntax and extract useful information to pass to the diff --git a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/tc-expr-unit.rkt b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/tc-expr-unit.rkt index e86f2963f3..3b7e62a09c 100644 --- a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/tc-expr-unit.rkt +++ b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/tc-expr-unit.rkt @@ -236,8 +236,7 @@ #:literal-sets (kernel-literals tc-expr-literals) ;; a TR-annotated class [stx:tr:class^ - (check-class form expected) - expected] + (check-class form expected)] [stx:exn-handlers^ (register-ignored! form) (check-subforms/with-handlers/check form expected)] diff --git a/pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/unit-tests/class-tests.rkt b/pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/unit-tests/class-tests.rkt index fd663a9f78..9b2455c057 100644 --- a/pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/unit-tests/class-tests.rkt +++ b/pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/unit-tests/class-tests.rkt @@ -1316,4 +1316,11 @@ (define/public (m a-foo) (get-field x a-foo)))) (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)] ))