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

Check more clause presence/absence appropriately

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

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

@ -200,14 +200,14 @@
(for/set ([(name val) (in-dict inits)] (for/set ([(name val) (in-dict inits)]
#:when (cadr val)) #:when (cadr val))
name)) name))
;; FIXME: these three should probably be `check-same` (check-same (set-union this%-init-names
(check-exists (set-union this%-init-names super-init-names) (list->set (dict-keys remaining-super-inits)))
exp-init-names exp-init-names
"initialization argument") "initialization argument")
(check-exists (set-union this%-public-names super-method-names) (check-same (set-union this%-public-names super-method-names)
exp-method-names exp-method-names
"public method") "public method")
(check-exists (set-union this%-field-names super-field-names) (check-same (set-union this%-field-names super-field-names)
exp-field-names exp-field-names
"public field") "public field")
(check-same exp-optional-inits this%-init-names (check-same exp-optional-inits this%-init-names
@ -216,14 +216,6 @@
"override method") "override method")
(check-absent super-field-names this%-field-names "public field") (check-absent super-field-names this%-field-names "public field")
(check-absent super-method-names this%-public-names "public method") (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 ;; trawl the body for the local name table
(define locals (trawl-for-property #'body 'tr:class:local-table)) (define locals (trawl-for-property #'body 'tr:class:local-table))
(define-values (local-method-table local-private-table local-field-table) (define-values (local-method-table local-private-table local-field-table)

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

@ -152,13 +152,31 @@
[m (-> Integer)])) [m (-> Integer)]))
(define n% (class: j% (super-new)))) (define n% (class: j% (super-new))))
;; should fail, too many methods (FIXME) ;; should fail, too many methods
#| (check-err
(: o% (Class)) (: o% (Class))
(define o% (class: object% (define o% (class: object%
(super-new) (super-new)
(define/public (m) 0))) (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 ;; Mixin on classes without row polymorphism
(check-ok (check-ok