Make sure super inits that are provided don't count

original commit: c009948627fea6555a91e37e5d76c8370d0df13f
This commit is contained in:
Asumu Takikawa 2013-05-21 00:20:21 -04:00
parent 6fd920cee9
commit 4aa3c2a639
2 changed files with 28 additions and 6 deletions

View File

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

View File

@ -345,6 +345,23 @@
(init x))
(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
(check-ok
(define c% (class: object% (super-new)