From 3e9cb6c3324b5fa5b5886217a09e343de3e32373 Mon Sep 17 00:00:00 2001 From: Asumu Takikawa Date: Fri, 18 Apr 2014 18:12:22 -0400 Subject: [PATCH] Adjust TR class error messages Use the new error message format for most cases. Convert some internal errors to use int-err. original commit: 39aacf8239523a7eb45b307d9fd4bb0b45babc10 --- .../typecheck/check-class-unit.rkt | 43 +++++++++++-------- .../typed-racket/unit-tests/class-tests.rkt | 29 +++++++------ 2 files changed, 41 insertions(+), 31 deletions(-) diff --git a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/check-class-unit.rkt b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/check-class-unit.rkt index 617cc791..a1055dfa 100644 --- a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/check-class-unit.rkt +++ b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/check-class-unit.rkt @@ -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 Set 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 Set 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 Set 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))) diff --git a/pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/unit-tests/class-tests.rkt b/pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/unit-tests/class-tests.rkt index 6a511d4f..dac0e96c 100644 --- a/pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/unit-tests/class-tests.rkt +++ b/pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/unit-tests/class-tests.rkt @@ -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 #|