suzanne.soy/typed-racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Type-check class top-level expressions

Browse Source 
original commit: dc35a8cd4db8f2a0cf9424aac50aad7960eb1074
This commit is contained in:
Asumu Takikawa 2013-05-19 16:14:15 -04:00
parent 4356293a59
commit 59a5c57f42
2 changed files with 23 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/check-class-unit.rkt
View File

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

14
pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/unit-tests/class-tests.rkt
View File

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