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

Improve TR error messages for class instantiation

Browse Source
This commit is contained in:
Asumu Takikawa 2014-05-18 17:14:38 -04:00
parent 8b245240ea
commit 27524e6579
2 changed files with 17 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/tc-app/tc-app-objects.rkt
View File

@ -60,8 +60,10 @@
[(and c (Class: _ inits fields _ _ init-rest)) [(and c (Class: _ inits fields _ _ init-rest))
(cond [;; too many positional arguments, fail (cond [;; too many positional arguments, fail
(and (> (length pos-args) (length inits)) (not init-rest)) (and (> (length pos-args) (length inits)) (not init-rest))
;; FIXME: better message (tc-error/fields "failure in class instantiation"
(tc-error "too many positional arguments supplied")] #:more "too many positional arguments supplied"
"expected" (format "~a arguments" (length inits))
"given" (format "~a arguments" (length pos-args)))]
[;; more args than inits, now feed them to init-rest [;; more args than inits, now feed them to init-rest
(and (> (length pos-args) (length inits))) (and (> (length pos-args) (length inits)))
(define-values (pos-for-inits other-pos) (define-values (pos-for-inits other-pos)
@ -80,8 +82,12 @@
(tc-expr/check pos-arg (ret type))) (tc-expr/check pos-arg (ret type)))
(check-named-inits other-inits given-names name-assoc)]) (check-named-inits other-inits given-names name-assoc)])
(ret (make-Instance c))] (ret (make-Instance c))]
[(ClassTop:) (tc-error/expr/fields "failure in class instantiation"
#:more "cannot instantiate a value of type ClassTop")]
[t [t
(tc-error/expr "expected a class value for object creation, got: ~a" t)])) (tc-error/expr/fields "failure in class instantiation"
#:more "given a value of a non-class type"
"given" t)]))
(define (check-named-inits inits names name-assoc) (define (check-named-inits inits names name-assoc)
(define init-names (map car inits)) (define init-names (map car inits))

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

@ -1420,4 +1420,11 @@
(define/public (m arg ...) . body)) (define/public (m arg ...) . body))
(my-meth (hello) (displayln "hello world")))) (my-meth (hello) (displayln "hello world"))))
(send (new c%) hello)) (send (new c%) hello))
-Void])) -Void]
;; the next few tests check failing class instantiation
[tc-err (make-object object% 1)
#:msg #rx"expected: 0 arguments.*given: 1 arguments"]
[tc-err (make-object (ann object% ClassTop))
#:msg #rx"cannot instantiate.*ClassTop"]
[tc-err (make-object 3)
#:msg #rx"value of a non-class type"]))