Fix uses of expected in tc-app-list.

This commit is contained in:
Eric Dobson 2014-03-19 22:58:37 -07:00
parent c7ef6fc6dd
commit 90556817eb
2 changed files with 17 additions and 6 deletions

View File

@ -79,14 +79,15 @@
[(tc-result1: (Listof: elem-ty)) [(tc-result1: (Listof: elem-ty))
(for ([i (in-syntax #'args)]) (for ([i (in-syntax #'args)])
(tc-expr/check i (ret elem-ty))) (tc-expr/check i (ret elem-ty)))
expected] (ret (-lst elem-ty))]
[(tc-result1: (List: (? (lambda (ts) (= (syntax-length #'args) [(tc-result1: (List: (? (lambda (ts) (= (syntax-length #'args)
(length ts))) (length ts)))
ts))) ts)))
(for ([ac (in-syntax #'args)] (match (for/list ([ac (in-syntax #'args)]
[exp (in-list ts)]) [exp (in-list ts)])
(tc-expr/check ac (ret exp))) (tc-expr/check ac (ret exp)))
expected] [(list (tc-result1: t) ...)
(ret (-Tuple t))])]
[_ [_
(let ([tys (stx-map tc-expr/t #'args)]) (let ([tys (stx-map tc-expr/t #'args)])
(ret (apply -lst* tys)))])) (ret (apply -lst* tys)))]))
@ -101,7 +102,7 @@
(tc-expr/check #'arg expected)] (tc-expr/check #'arg expected)]
[(tc-result1: (List: ts)) [(tc-result1: (List: ts))
(tc-expr/check #'arg (ret (-Tuple (reverse ts)))) (tc-expr/check #'arg (ret (-Tuple (reverse ts))))
expected] (ret (-Tuple ts))]
[_ [_
(match (single-value #'arg) (match (single-value #'arg)
[(tc-result1: (List: ts)) [(tc-result1: (List: ts))

View File

@ -2519,6 +2519,16 @@
[tc-err (ann (lambda () (let ([my-values values]) (my-values))) [tc-err (ann (lambda () (let ([my-values values]) (my-values)))
(All (A ...) (-> (Values Symbol ... A))))] (All (A ...) (-> (Values Symbol ... A))))]
[tc-e (list 'x)
#:ret (ret (-Tuple (list -Symbol)))
#:expected (ret (-Tuple (list -Symbol)) -no-filter -no-obj)]
[tc-e (list 'y)
#:ret (ret (-lst -Symbol))
#:expected (ret (-lst -Symbol) -no-filter -no-obj)]
[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)]
) )
(test-suite (test-suite
"tc-literal tests" "tc-literal tests"