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

Make tc-values not misuse expected.

Browse Source 
original commit: e355539c41958de8fe6a992c5ea603cc3725065f
This commit is contained in:
Eric Dobson 2014-03-20 00:22:26 -07:00
parent b518da29d3
commit f241d2b36b
2 changed files with 16 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/tc-app/tc-app-values.rkt
View File

@ -5,7 +5,7 @@
"utils.rkt"
syntax/parse racket/match unstable/sequence unstable/syntax
(typecheck signatures tc-funapp)
(types utils)
(types utils abbrev)
(for-label racket/base))
@ -33,13 +33,13 @@
(single-value #'arg expected)]
[(tc-results: ts)
(single-value #'arg) ;Type check the argument, to find other errors
(tc-error/expr #:return expected
(tc-error/expr #:return (ret -Bottom)
"wrong number of values: expected ~a but got one"
(length ts))]
;; match polydots case and error
[(tc-results: ts _ _ dty dbound)
(single-value #'arg)
(tc-error/expr #:return expected
(tc-error/expr #:return (ret -Bottom)
"Expected ~a ..., but got only one value" dty)]))
;; handle `values' specially
(pattern (values . args)
@ -53,7 +53,7 @@
(single-value arg (ret et ef eo)))])
(if (= (length ts) (length ets) (syntax-length #'args))
(ret ts fs os)
(tc-error/expr #:return expected "wrong number of values: expected ~a but got ~a"
(tc-error/expr #:return (ret -Bottom) "wrong number of values: expected ~a but got ~a"
(length ets) (syntax-length #'args))))]
[_ (match-let ([(list (tc-result1: ts fs os) ...)
(for/list ([arg (in-syntax #'args)])

12
pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/unit-tests/typecheck-tests.rkt
View File

@ -2598,6 +2598,18 @@
#:ret (ret (make-HeterogeneousVector (list -Byte -Byte)) -false-filter -empty-obj)
#:expected (ret (make-HeterogeneousVector (list -Byte -Byte)) -false-filter -no-obj)]
[tc-err (values 'x)
#:ret (ret (list -Symbol -Symbol) (list -top-filter -top-filter) (list -empty-obj -empty-obj))
#:expected (ret (list -Symbol -Symbol) (list -no-filter -no-filter ) (list -no-obj -no-obj))]
[tc-err (values 'x 'y 'z)
#:ret (ret (list -Symbol -Symbol) (list -top-filter -top-filter) (list -empty-obj -empty-obj))
#:expected (ret (list -Symbol -Symbol) (list -no-filter -no-filter ) (list -no-obj -no-obj))]
[tc-err (values 'y)
#:ret (ret (list -Symbol) (list -top-filter ) (list -empty-obj) Univ 'B)
#:expected (ret (list -Symbol) (list -no-filter ) (list -no-obj) Univ 'B)]
)
(test-suite
"tc-literal tests"