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

Check more clause presence/absence appropriately

Browse Source 
original commit: f188d7f1030d4d48abe3d5d6cc2759403808084d
This commit is contained in:
Asumu Takikawa 2013-05-21 18:59:04 -04:00
parent 7bf90d1894
commit e942e91fb5
2 changed files with 44 additions and 34 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -193,37 +193,29 @@
;; Use the internal class: information to check whether clauses
;; exist or are absent appropriately
(when expected?
(define exp-init-names (list->set (dict-keys inits)))
(define exp-field-names (list->set (dict-keys fields)))
(define exp-method-names (list->set (dict-keys methods)))
(define exp-optional-inits
(for/set ([(name val) (in-dict inits)]
#:when (cadr val))
name))
;; FIXME: these three should probably be `check-same`
(check-exists (set-union this%-init-names super-init-names)
exp-init-names
"initialization argument")
(check-exists (set-union this%-public-names super-method-names)
exp-method-names
"public method")
(check-exists (set-union this%-field-names super-field-names)
exp-field-names
"public field")
(check-same exp-optional-inits this%-init-names
"optional init argument"))
(define exp-init-names (list->set (dict-keys inits)))
(define exp-field-names (list->set (dict-keys fields)))
(define exp-method-names (list->set (dict-keys methods)))
(define exp-optional-inits
(for/set ([(name val) (in-dict inits)]
#:when (cadr val))
name))
(check-same (set-union this%-init-names
(list->set (dict-keys remaining-super-inits)))
exp-init-names
"initialization argument")
(check-same (set-union this%-public-names super-method-names)
exp-method-names
"public method")
(check-same (set-union this%-field-names super-field-names)
exp-field-names
"public field")
(check-same exp-optional-inits this%-init-names
"optional init argument"))
(check-exists super-method-names this%-override-names
"override method")
(check-absent super-field-names this%-field-names "public field")
(check-absent super-method-names this%-public-names "public method")
;; FIXME: the control flow for the failure of these checks is
;; still up in the air
#|
(check-no-extra (set-union this%-field-names super-field-names)
exp-field-names)
(check-no-extra (set-union this%-public-names super-method-names)
exp-method-names)
|#
;; trawl the body for the local name table
(define locals (trawl-for-property #'body 'tr:class:local-table))
(define-values (local-method-table local-private-table local-field-table)

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

@ -152,13 +152,31 @@
[m (-> Integer)]))
(define n% (class: j% (super-new))))
;; should fail, too many methods (FIXME)
#|
(: o% (Class))
(define o% (class: object%
(super-new)
(define/public (m) 0)))
|#
;; should fail, too many methods
(check-err
(: o% (Class))
(define o% (class: object%
(super-new)
(define/public (m) 0))))
;; same as previous
(check-err
(: c% (Class [m (Integer -> Integer)]))
(define c% (class: object% (super-new)
(define/public (m x) (add1 x))
(define/public (n) 0))))
;; fails, too many inits
(check-err
(: c% (Class (init [str String #:optional])))
(define c% (class: object% (super-new)
(init str x))))
;; fails, too many fields
(check-err
(: c% (Class (field [str String])))
(define c% (class: object% (super-new)
(field [str "foo"] [x 0]))))
;; Mixin on classes without row polymorphism
(check-ok