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

Adjust TR class error messages

Browse Source 
Use the new error message format for most cases.
Convert some internal errors to use int-err.

original commit: 39aacf8239523a7eb45b307d9fd4bb0b45babc10
This commit is contained in:
Asumu Takikawa 2014-04-18 18:12:22 -04:00
parent 12e85ba9b6
commit 3e9cb6c332
2 changed files with 41 additions and 31 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -535,7 +535,9 @@
;; the expansion.
[(~and :tr:class:super-new^ (#%plain-app . rst))
(when super-new
(tc-error/delayed "typed classes must only call super-new a single time"))
(tc-error/fields #:delayed? #t
"ill-formed typed class"
#:more "must only call `super-new' a single time"))
(set! super-new (find-provided-inits expr))
other-exprs]
[(~and t:class-type-declaration :tr:class:type-annotation^)
@ -553,7 +555,9 @@
other-exprs]
[_ (cons expr other-exprs)])))
(unless super-new
(tc-error/delayed "typed classes must call super-new at the class top-level")
(tc-error/fields #:delayed? #t
"ill-formed typed class"
#:more "must call `super-new' at the top-level of the class")
(set! super-new (super-init-stxs null null)))
(values super-new
initializers
@ -1449,46 +1453,51 @@
(case-lambda
[(annotated-self x ...) body] ...)])
m)]
[_ (tc-error "annotate-method: internal error")]))
[_ (int-err "annotate-method: internal error")]))
;; Set<Symbol> Set<Symbol> String -> Void
;; check that all the required names are actually present
;;
;; FIXME: This gives bad error messages. Consider using syntax
;; object lists instead of sets.
(define (check-exists actual required msg)
(define (check-exists actual required kind)
(define missing
(for/or ([m (in-set required)])
(and (not (set-member? actual m)) m)))
(when missing
(tc-error/delayed (~a "superclass missing ~a ~a "
"that the current class requires")
msg missing)))
(tc-error/fields #:delayed? #t
"inheritance mismatch"
#:more (~a "the superclass is missing a required " kind)
(~a "missing " kind) missing)))
;; Set<Symbol> Set<Symbol> String -> Void
;; check that names are absent when they should be
(define (check-absent actual should-be-absent msg)
(define (check-absent actual should-be-absent kind)
(define present
(for/or ([m (in-set should-be-absent)])
(and (set-member? actual m) m)))
(when present
(tc-error/delayed "superclass defines conflicting ~a ~a"
msg present)))
(tc-error/fields #:delayed? #t
"inheritance mismatch"
#:more (~a "the superclass has a conflicting " kind)
kind present)))
;; Set<Symbol> Set<Symbol> String -> Void
;; check that the names are exactly the same as expected
(define (check-same actual expected msg)
(define (check-same actual expected kind)
(define missing
(for/or ([m (in-set expected)])
(and (not (set-member? actual m)) m)))
(when missing
(tc-error/delayed (~a "class definition missing ~a ~a "
"that is required by the expected type")
msg missing))
(tc-error/fields #:delayed? #t
"type mismatch"
#:more (~a "the class is missing a required " kind)
(~a "missing " kind) missing))
(define too-many
(for/or ([m (in-set actual)])
(and (not (set-member? expected m)) m)))
(when too-many
(tc-error/delayed (~a "class definition contains ~a ~a "
"that is not in the expected type")
msg too-many)))
(tc-error/fields #:delayed? #t
"type mismatch"
#:more (~a "the class has a " kind " that should be absent")
kind too-many)))

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

@ -164,7 +164,7 @@
(super-new)))
(void))
#:ret (ret -Void)
#:msg #rx"defines conflicting public field n"]
#:msg #rx"has a conflicting public field.*field: n"]
;; Fail, conflict with parent method
[tc-err (let ()
(: j% (Class [m (-> Integer)]))
@ -177,7 +177,7 @@
(define/public (m) 17)))
(void))
#:ret (ret -Void)
#:msg #rx"defines conflicting public method m"]
#:msg #rx"has a conflicting public method.*method: m"]
;; Inheritance
[tc-e (let ()
(: j% (Class (field [n Integer])
@ -203,7 +203,7 @@
(define/public (m) 0)))
(void))
#:ret (ret -Void)
#:msg #rx"public method m that is not in the expected type"]
#:msg #rx"public method that should be absent.*method: m"]
;; same as previous
[tc-err (let ()
(: c% (Class [m (Integer -> Integer)]))
@ -212,7 +212,7 @@
(define/public (n) 0)))
(void))
#:ret (ret -Void)
#:msg #rx"public method n that is not in the expected type"]
#:msg #rx"public method that should be absent.*method: n"]
;; fails, too many inits
[tc-err (let ()
(: c% (Class))
@ -220,7 +220,7 @@
(init x)))
(void))
#:ret (ret -Void)
#:msg #rx"initialization argument x that is not in the expected type"]
#:msg #rx"initialization argument that should be absent.*argument: x"]
;; fails, init should be optional but is mandatory
[tc-err (let ()
(: c% (Class (init [str String #:optional])))
@ -228,7 +228,7 @@
(init str)))
(void))
#:ret (ret -Void)
#:msg #rx"missing optional init argument str"]
#:msg #rx"missing a required optional init argument.*argument: str"]
;; fails, too many fields
[tc-err (let ()
(: c% (Class (field [str String])))
@ -236,7 +236,7 @@
(field [str "foo"] [x 0])))
(void))
#:ret (ret -Void)
#:msg #rx"public field x that is not in the expected type"]
#:msg #rx"has a public field that should be absent.*public field: x"]
;; test that an init with no annotation still type-checks
;; (though it will have the Any type)
[tc-e (let () (class object% (super-new) (init x)) (void)) -Void]
@ -281,7 +281,7 @@
(mixin arg-class%))
#:ret (ret (-class #:method ([m (t:-> -Integer)] [n (t:-> -String)])))
#:msg #rx"missing public method n"]
#:msg #rx"missing a required public method.*missing public method: n"]
;; Fail, bad mixin argument
[tc-err (let ()
(: mixin ((Class [m (-> Symbol)])
@ -337,7 +337,7 @@
(define c% (class object% (init x)))
(void))
#:ret (ret -Void)
#:msg #rx"typed classes must call super-new"]
#:msg #rx"must call `super-new'"]
;; fails, non-top-level super-new
;; FIXME: this case also spits out additional untyped identifier
;; errors which should be squelched maybe
@ -346,7 +346,7 @@
(define c% (class object% (let () (super-new)) (init x)))
(void))
#:ret (ret -Void)
#:msg #rx"typed classes must call super-new"]
#:msg #rx"must call `super-new'"]
;; fails, bad super-new argument
[tc-err (let ()
(: c% (Class (init [x Symbol])))
@ -541,7 +541,7 @@
(init [x 0])))
(void))
#:ret (ret -Void)
#:msg #rx"optional init argument x that is not in the expected type"]
#:msg #rx"has a optional init argument that should be absent"]
;; fails, mandatory init not provided
[tc-err (let ()
(define d% (class object% (super-new)
@ -570,7 +570,8 @@
#:ret (ret (-object))]
;; fails, super-new can only be called once per class
[tc-err (class object% (super-new) (super-new))
#:ret (ret (-class))]
#:ret (ret (-class))
#:msg #rx"`super-new' a single time"]
;; test passing an init arg to super-new
[tc-e (let ()
(define c% (class (class object% (super-new)
@ -636,7 +637,7 @@
(super-new)
(inherit-field [y x]))
#:ret (ret (-class))
#:msg #rx"superclass missing field"]
#:msg #rx"superclass is missing a required field"]
;; fails, missing super method for inherit
[tc-err (class (class object% (super-new)) (super-new) (inherit z))
#:ret (ret (-class))]
@ -1101,7 +1102,7 @@
(define/augment (m x) 1)))
(void))
#:ret (ret -Void)
#:msg #rx"superclass missing augmentable method m"]
#:msg #rx"superclass is missing a required augmentable method"]
;; Pubment with separate internal/external names
;; FIXME: broken right now due to : macro changes
#|