diff --git a/collects/tests/typed-racket/unit-tests/typecheck-tests.rkt b/collects/tests/typed-racket/unit-tests/typecheck-tests.rkt index 084e8a60..899add9d 100644 --- a/collects/tests/typed-racket/unit-tests/typecheck-tests.rkt +++ b/collects/tests/typed-racket/unit-tests/typecheck-tests.rkt @@ -1602,6 +1602,16 @@ (list (-vec -Integer) (-vec -Integer))] [tc-e/t (ann ((letrec ((x (lambda args 3))) x) 1 2) Byte) -Byte] + [tc-e (vector-ref (ann (vector 'a 'b) (Vector Symbol Symbol)) 0) + -Symbol] + [tc-err (vector-ref (ann (vector 'a 'b) (Vector Symbol Symbol)) 4)] + [tc-e (vector-ref (ann (vector 'a 'b) (Vector Symbol Symbol)) (+ -1 2)) + -Symbol] + [tc-e (vector-set! (ann (vector 'a 'b) (Vector Symbol Symbol)) 0 'c) + -Void] + [tc-err (vector-set! (ann (vector 'a 'b) (Vector Symbol Symbol)) -4 'c)] + [tc-e (vector-set! (ann (vector 'a 'b) (Vector Symbol Symbol)) (+ -1 2) 'c) + -Void] ) (test-suite "check-type tests" diff --git a/collects/typed-racket/typecheck/tc-app/tc-app-hetero.rkt b/collects/typed-racket/typecheck/tc-app/tc-app-hetero.rkt index 7b866e9f..d6b1efe5 100644 --- a/collects/typed-racket/typecheck/tc-app/tc-app-hetero.rkt +++ b/collects/typed-racket/typecheck/tc-app/tc-app-hetero.rkt @@ -20,18 +20,18 @@ - (define (tc/index expr) (syntax-parse expr [((~literal quote) i:number) (let ((type (tc-literal #'i))) (add-typeof-expr expr (ret type)) - (values type (syntax-e #'i)))] + (syntax-e #'i))] [_ (match (tc-expr expr) - [(and type (tc-result1: (Value: (? number? i)))) - (values type i)] - [type (values type #f)])])) + [(tc-result1: (Value: (? number? i))) i] + [type + (check-below type -Integer) + #f])])) (define (index-error i-val i-bound expr type expected name) (define return (or expected (ret (Un)))) @@ -49,30 +49,28 @@ ;; FIXME - Do something with paths in the case that a structure/vector is not mutable (define (tc/hetero-ref i-e es-t vec-t expected name) - (define-values (i-t i-val) (tc/index i-e)) + (define i-val (tc/index i-e)) (define i-bound (length es-t)) (cond [(valid-index? i-val i-bound) (ret (list-ref es-t i-val))] [(not i-val) - (check-below i-t -Integer) (ret (apply Un es-t))] [else (index-error i-val i-bound i-e vec-t expected name)])) (define (tc/hetero-set! i-e es-t val-e vec-t expected name) - (define-values (i-t i-val) (tc/index i-e)) + (define i-val (tc/index i-e)) (define i-bound (length es-t)) (cond [(valid-index? i-val i-bound) (tc-expr/check val-e (ret (list-ref es-t i-val))) (ret -Void)] [(not i-val) - (single-value val-e) - (tc-error/expr - #:stx i-e #:return (or expected (ret -Void)) - "expected statically known index for ~a mutation, but got ~a" - name (match i-t [(tc-result1: t) t]))] + (define val-t (single-value val-e)) + (for ((es-type es-t)) + (check-below val-t es-type)) + (cond-check-below (ret -Void) expected)] [else (single-value val-e) (index-error i-val i-bound i-e vec-t expected name)]))