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

TR: fix error case when superclass is not a class

Browse Source
This commit is contained in:
Asumu Takikawa 2014-03-05 01:33:45 -05:00
parent 0bacba7a68
commit a0ce1fa02c
2 changed files with 10 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -329,9 +329,12 @@
(values super-row super-inits super-fields (values super-row super-inits super-fields
super-methods super-augments super-init-rest)] super-methods super-augments super-init-rest)]
[(tc-result1: t) [(tc-result1: t)
(tc-error/expr "expected a superclass but got value of type ~a" t (tc-error/expr/fields "type mismatch"
#:stx (hash-ref parse-info 'superclass-expr)) #:more "superclass expression should produce a class"
(values #f null null null null)])) #:stx (hash-ref parse-info 'superclass-expr)
"expected" "a class"
"given" t)
(values #f null null null null #f)]))
(define super-init-names (dict-keys super-inits)) (define super-init-names (dict-keys super-inits))
(define super-field-names (dict-keys super-fields)) (define super-field-names (dict-keys super-fields))
(define super-method-names (dict-keys super-methods)) (define super-method-names (dict-keys super-methods))

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

@ -45,7 +45,7 @@
(init x) (init x)
(define/public (m x) 0))) (define/public (m x) 0)))
(void)) (void))
#:msg #rx"expected a superclass but"] #:msg #rx"superclass expression should produce a class"]
;; Method using argument type ;; Method using argument type
[tc-e (let () [tc-e (let ()
(: e% (Class (init [x Integer]) (: e% (Class (init [x Integer])
@ -173,6 +173,9 @@
(define n% (class j% (super-new))) (define n% (class j% (super-new)))
(void)) (void))
-Void] -Void]
;; fail, superclass expression is not a class with no expected type
[tc-err (class "foo" (super-new))
#:msg "expected: a class"]
;; should fail, too many methods ;; should fail, too many methods
[tc-err (let () [tc-err (let ()
(: o% (Class)) (: o% (Class))