diff --git a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/tc-app/tc-app-hetero.rkt b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/tc-app/tc-app-hetero.rkt index a27f018c59..3b86e67e28 100644 --- a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/tc-app/tc-app-hetero.rkt +++ b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/tc-app/tc-app-hetero.rkt @@ -109,14 +109,18 @@ (tc-expr/check e (ret t)) t)))] [(tc-result1: (app resolve (HeterogeneousVector: ts))) - (unless (= (length ts) (syntax-length #'(args ...))) - (tc-error/expr "expected vector with ~a elements, but got ~a" - (length ts) - (make-HeterogeneousVector (stx-map tc-expr/t #'(args ...))))) - (for ([e (in-syntax #'(args ...))] - [t (in-list ts)]) - (tc-expr/check e (ret t))) - expected] + (cond + [(= (length ts) (syntax-length #'(args ...))) + (ret + (make-HeterogeneousVector + (for/list ([e (in-syntax #'(args ...))] + [t (in-list ts)]) + (tc-expr/check/t e (ret t)))) + -true-filter)] + [else + (tc-error/expr #:return (ret -Bottom) + "expected vector with ~a elements, but got ~a" + (length ts) (make-HeterogeneousVector (stx-map tc-expr/t #'(args ...))))])] ;; If the expected type is a union, then we examine just the parts ;; of the union that are vectors. If there's only one of those, ;; we re-run this whole algorithm with that. Otherwise, we treat diff --git a/pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/fail/heterogeneous-vector-bad-ann.rkt b/pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/fail/heterogeneous-vector-bad-ann.rkt new file mode 100644 index 0000000000..e938f63b92 --- /dev/null +++ b/pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/fail/heterogeneous-vector-bad-ann.rkt @@ -0,0 +1,5 @@ +#; +(exn-pred 2) +#lang typed/racket + +(ann (vector (ann 1 Symbol)) (Vector Number Symbol)) diff --git a/pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/unit-tests/typecheck-tests.rkt b/pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/unit-tests/typecheck-tests.rkt index 4f0157e16e..4c017f08c8 100644 --- a/pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/unit-tests/typecheck-tests.rkt +++ b/pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/unit-tests/typecheck-tests.rkt @@ -2593,6 +2593,11 @@ [tc-e (reverse (list 'x 'y)) #:ret (ret (-Tuple (list (-val 'y) (-val 'x)))) #:expected (ret (-Tuple (list (-val 'y) (-val 'x))) -no-filter -no-obj)] + + [tc-err (vector 1 2) + #:ret (ret (make-HeterogeneousVector (list -Byte -Byte)) -false-filter -empty-obj) + #:expected (ret (make-HeterogeneousVector (list -Byte -Byte)) -false-filter -no-obj)] + ) (test-suite "tc-literal tests"