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

Fix unannotated defines with bad number of values

Browse Source
This commit is contained in:
Asumu Takikawa 2014-09-12 18:17:25 -04:00
parent d495f74648
commit efd482c30f
4 changed files with 14 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/tc-let-unit.rkt
View File

@ -218,7 +218,8 @@
(cond [(null? clauses) (k)] (cond [(null? clauses) (k)]
[else [else
(match-define (lr-clause names expr) (car clauses)) (match-define (lr-clause names expr) (car clauses))
(match-define (list (tc-result: ts fs os) ...) (match-define (or (tc-results: (list ts ...) _ (list os ...))
(list (tc-result: ts _ os) ...))
(get-type/infer names expr (get-type/infer names expr
(lambda (e) (tc-expr/maybe-expected/t e names)) (lambda (e) (tc-expr/maybe-expected/t e names))
tc-expr/check)) tc-expr/check))

3
pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/tc-toplevel.rkt
View File

@ -174,7 +174,8 @@
;; the module (hence we haven't synthesized a type for yet). ;; the module (hence we haven't synthesized a type for yet).
[_ [_
(match (get-type/infer vars #'expr tc-expr tc-expr/check) (match (get-type/infer vars #'expr tc-expr tc-expr/check)
[(list (tc-result: ts) ...) [(or (list (tc-result: ts) ...)
(tc-results: (list ts ...)))
(for/list ([i (in-list vars)] [t (in-list ts)]) (for/list ([i (in-list vars)] [t (in-list ts)])
(register-type i t) (register-type i t)
(free-id-table-set! unann-defs i #t) (free-id-table-set! unann-defs i #t)

5
pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/unit-tests/interactive-tests.rkt
View File

@ -114,6 +114,11 @@
(test-form-exn #rx"either undefined or missing a type annotation" (test-form-exn #rx"either undefined or missing a type annotation"
(a-name-that-isnt-bound)) (a-name-that-isnt-bound))
;; Make sure unannotated definitions with the wrong number of values
;; don't produce an internal error
(test-form-exn #rx"Expression should produce 1 values"
(define zzzzz (values 1 2)))
(test-form #rx"1" (test-form #rx"1"
(:type 1)) (:type 1))
(test-form (regexp-quote "(U Positive-Byte Zero)") (test-form (regexp-quote "(U Positive-Byte Zero)")

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

@ -3275,6 +3275,11 @@
(tr:define (foo) : (Values String String) (values "foo" "bar")) (tr:define (foo) : (Values String String) (values "foo" "bar"))
(void)) (void))
-Void] -Void]
;; Make sure unannotated definitions with the wrong number of values
;; don't produce an internal error
[tc-err (let () (define x (values 1 2)) (error "dummy"))
#:msg #rx"Expression should produce 1 values"]
) )
(test-suite (test-suite