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

Fix type-checking for fields with this

Browse Source
This commit is contained in:
Asumu Takikawa 2013-05-23 16:47:06 -04:00
parent 6b5875a1f1
commit f82a49be7d
2 changed files with 14 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -528,8 +528,8 @@
(λ (e) (tc-error/expr "Default init value has wrong type"))]) (λ (e) (tc-error/expr "Default init value has wrong type"))])
(parameterize ([delay-errors? #f]) (parameterize ([delay-errors? #f])
(with-lexical-env/extend (with-lexical-env/extend
(list #'self #'init-args #'extract-arg) (list #'extract-arg)
(list (make-Univ) (make-Univ) extract-arg-type) (list extract-arg-type)
(tc-expr form))))] (tc-expr form))))]
;; If the type can't be found, it means that there was no ;; If the type can't be found, it means that there was no
;; expected type or no annotation was provided via (: ...). ;; expected type or no annotation was provided via (: ...).
@ -566,8 +566,8 @@
(λ (e) (tc-error/expr "Default init value has wrong type"))]) (λ (e) (tc-error/expr "Default init value has wrong type"))])
(parameterize ([delay-errors? #f]) (parameterize ([delay-errors? #f])
(with-lexical-env/extend (with-lexical-env/extend
(list #'self #'init-args #'extract-arg) (list #'extract-arg)
(list (make-Univ) (make-Univ) extract-arg-type) (list extract-arg-type)
(tc-expr form))))] (tc-expr form))))]
[else [else
(tc-error/expr "Init argument ~a has no type annotation" (tc-error/expr "Init argument ~a has no type annotation"
@ -580,8 +580,7 @@
(#%plain-app local-setter:id obj2:id y:id))) (#%plain-app local-setter:id obj2:id y:id)))
#:when (free-identifier=? #'x #'y) #:when (free-identifier=? #'x #'y)
#:when (free-identifier=? #'obj1 #'obj2) #:when (free-identifier=? #'obj1 #'obj2)
(with-lexical-env/extend (list #'self) (list (make-Univ)) (tc-expr form)]
(tc-expr form))]
[_ (void)]))) [_ (void)])))
;; Syntax -> Dict<Symbol, Id> Dict<Symbol, Id> ;; Syntax -> Dict<Symbol, Id> Dict<Symbol, Id>

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

@ -536,6 +536,15 @@
(: x (Instance (Class))) (: x (Instance (Class)))
(define x (new c%))) (define x (new c%)))
;; test use of `this` in field default
(check-ok
(class: object%
(super-new)
(: x Integer)
(field [x 0])
(: y Integer)
(field [y (get-field x this)])))
;; test different internal/external names ;; test different internal/external names
(check-ok (check-ok
(define c% (class: object% (super-new) (define c% (class: object% (super-new)