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

Make sure super inits that are provided don't count

Browse Source
This commit is contained in:
Asumu Takikawa 2013-05-21 00:20:21 -04:00
parent b1627984e2
commit c009948627
2 changed files with 28 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -170,7 +170,11 @@
(define internals-table (register-internals top-level-exprs)) (define internals-table (register-internals top-level-exprs))
;; find the `super-new` call (or error if missing) ;; find the `super-new` call (or error if missing)
(define super-new-stx (trawl-for-property #'body 'tr:class:super-new)) (define super-new-stx (trawl-for-property #'body 'tr:class:super-new))
(check-super-new super-new-stx super-inits) (define provided-super-inits (check-super-new super-new-stx super-inits))
(define remaining-super-inits
(for/list ([(name val) (in-dict super-inits)]
#:unless (member name provided-super-inits))
(cons name val)))
;; Type for self in method calls ;; Type for self in method calls
(define self-type (define self-type
(if self-class-type (if self-class-type
@ -178,7 +182,7 @@
(infer-self-type internals-table (infer-self-type internals-table
optional-inits optional-inits
internal-external-mapping internal-external-mapping
super-inits remaining-super-inits
super-fields super-fields
super-methods super-methods
this%-init-internals this%-init-internals
@ -389,7 +393,8 @@
(if maybe-expected (if maybe-expected
(tc-expr/check init-arg (ret (car maybe-expected))) (tc-expr/check init-arg (ret (car maybe-expected)))
(tc-error/expr "init argument ~a not accepted by superclass" (tc-error/expr "init argument ~a not accepted by superclass"
init-id)))])])) init-id)))
provided-inits])]))
;; Syntax -> Listof<Syntax> ;; Syntax -> Listof<Syntax>
;; Look through the expansion of the class macro in search for ;; Look through the expansion of the class macro in search for
@ -453,9 +458,9 @@
(λ (type) (λ (type)
(define entry (define entry
(if inits? (if inits?
(list external type (set-member? optional-inits name)) (list type (set-member? optional-inits name))
(list external type))) (list type)))
(cons entry type-dict))] (dict-set type-dict external entry))]
[else type-dict]))) [else type-dict])))
(define init-types (make-type-dict inits super-inits #t)) (define init-types (make-type-dict inits super-inits #t))
(define field-types (make-type-dict fields super-fields)) (define field-types (make-type-dict fields super-fields))

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

@ -345,6 +345,23 @@
(init x)) (init x))
(super-new))) (super-new)))
;; test that provided super-class inits don't count
;; towards the type of current class
(check-ok
(: c% (Class))
(define c% (class: (class: object% (super-new)
(: x Integer)
(init x))
(super-new [x 3]))))
;; fails, super-class init already provided
(check-err
(define c% (class: (class: object% (super-new)
(: x Integer)
(init x))
(super-new [x 3])))
(new c% [x 5]))
;; 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)