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

Add annotation to test.

Browse Source 
Fix default case for `vector-set!'
This commit is contained in:
Sam Tobin-Hochstadt 2010-05-14 10:58:55 -04:00
parent ff36a6e8d1
commit 21b5c25c90
2 changed files with 7 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
collects/tests/typed-scheme/succeed/het-vec.ss
View File

@ -1,6 +1,6 @@
#lang typed/scheme #lang typed/scheme
(ann (vector-ref #(1 foo 3) 0) Integer) (ann (vector-ref (ann #(1 foo 3) (Vector Integer Symbol Any)) 0) Integer)
(define: x : (Vector Number String Symbol) (vector 1 "foo" 'bar)) (define: x : (Vector Number String Symbol) (vector 1 "foo" 'bar))

9
collects/typed-scheme/typecheck/tc-app.rkt
View File

@ -456,7 +456,7 @@
(tc-error/expr #:stx #'e #:return (or expected (ret (Un))) "index ~a too large for vector ~a" ival t)]))] (tc-error/expr #:stx #'e #:return (or expected (ret (Un))) "index ~a too large for vector ~a" ival t)]))]
[v-ty [v-ty
(let ([arg-tys (list v-ty e-t)]) (let ([arg-tys (list v-ty e-t)])
(tc/funapp #'op #'args (single-value #'op) arg-tys expected))]))] (tc/funapp #'op #'(v e) (single-value #'op) arg-tys expected))]))]
[(#%plain-app (~and op (~literal vector-set!)) v e:expr val:expr) [(#%plain-app (~and op (~literal vector-set!)) v e:expr val:expr)
(let ([e-t (single-value #'e)]) (let ([e-t (single-value #'e)])
(match (single-value #'v) (match (single-value #'v)
@ -475,14 +475,17 @@
(check-below (ret -Void) expected) (check-below (ret -Void) expected)
(ret -Void))] (ret -Void))]
[(not (and (integer? ival) (exact? ival))) [(not (and (integer? ival) (exact? ival)))
(single-value #'val)
(tc-error/expr #:stx #'e #:return (or expected (ret (Un))) "expected exact integer for vector index, but got ~a" ival)] (tc-error/expr #:stx #'e #:return (or expected (ret (Un))) "expected exact integer for vector index, but got ~a" ival)]
[(< ival 0) [(< ival 0)
(single-value #'val)
(tc-error/expr #:stx #'e #:return (or expected (ret (Un))) "index ~a too small for vector ~a" ival t)] (tc-error/expr #:stx #'e #:return (or expected (ret (Un))) "index ~a too small for vector ~a" ival t)]
[(not (<= ival (sub1 (length es)))) [(not (<= ival (sub1 (length es))))
(single-value #'val)
(tc-error/expr #:stx #'e #:return (or expected (ret (Un))) "index ~a too large for vector ~a" ival t)]))] (tc-error/expr #:stx #'e #:return (or expected (ret (Un))) "index ~a too large for vector ~a" ival t)]))]
[v-ty [v-ty
(let ([arg-tys (list v-ty e-t)]) (let ([arg-tys (list v-ty e-t (single-value #'val))])
(tc/funapp #'op #'args (single-value #'op) arg-tys expected))]))] (tc/funapp #'op #'(v e val) (single-value #'op) arg-tys expected))]))]
[(#%plain-app (~and op (~literal vector)) args:expr ...) [(#%plain-app (~and op (~literal vector)) args:expr ...)
(match expected (match expected
[(tc-result1: (Vector: t)) [(tc-result1: (Vector: t))