From 59a5c57f426bec41d5920290d729de47faae6986 Mon Sep 17 00:00:00 2001 From: Asumu Takikawa Date: Sun, 19 May 2013 16:14:15 -0400 Subject: [PATCH] Type-check class top-level expressions original commit: dc35a8cd4db8f2a0cf9424aac50aad7960eb1074 --- .../typed-racket/typecheck/check-class-unit.rkt | 13 +++++++++---- .../tests/typed-racket/unit-tests/class-tests.rkt | 14 ++++++++++++++ 2 files changed, 23 insertions(+), 4 deletions(-) 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 cc8a1715..bf8c078c 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 @@ -159,15 +159,20 @@ (define locals (trawl-for-property #'body 'tr:class:local-table)) (define-values (local-method-table local-private-table local-field-table) (construct-local-mapping-tables (car locals))) + ;; start type-checking elements in the body + (define-values (lexical-names lexical-types) + (local-tables->lexical-env local-method-table methods this%-method-names + local-field-table fields this%-field-names + self-type)) + (with-lexical-env/extend lexical-names lexical-types + (for ([stx top-level-exprs] + #:unless (syntax-property stx 'tr:class:super-new)) + (tc-expr stx))) ;; find the `super-new` call (or error if missing) (define super-new-stx (trawl-for-property #'body 'tr:class:super-new)) (check-super-new super-new-stx super-inits) ;; trawl the body and find methods and type-check them (define meths (trawl-for-property #'body 'tr:class:method)) - (define-values (lexical-names lexical-types) - (local-tables->lexical-env local-method-table methods this%-method-names - local-field-table fields this%-field-names - self-type)) (define checked-method-types (with-lexical-env/extend lexical-names lexical-types (check-methods meths methods self-type))) 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 359090b7..f3bca166 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 @@ -303,6 +303,20 @@ (define/public (m y) (begin0 x (set! x (+ x 1))))))) + ;; test top-level expressions in the class + (check-ok + (: c% (Class [m (Integer -> Integer)])) + (define c% (class: object% (super-new) + (define/public (m y) 0) + (+ 3 5)))) + + ;; fails, bad top-level expression + (check-err + (: c% (Class [m (Integer -> Integer)])) + (define c% (class: object% (super-new) + (define/public (m y) 0) + (+ "foo" 5)))) + ;; test type-checking without expected class type (check-ok (define c% (class: object% (super-new)