From 35a42d8598b9bbb161e54e3a25b13cb438c9eb8f Mon Sep 17 00:00:00 2001 From: Asumu Takikawa Date: Fri, 12 Sep 2014 18:17:25 -0400 Subject: [PATCH] Fix unannotated defines with bad number of values original commit: efd482c30ff80f73c159087c5196cc058595f68e --- .../typed-racket-lib/typed-racket/typecheck/tc-let-unit.rkt | 3 ++- .../typed-racket-lib/typed-racket/typecheck/tc-toplevel.rkt | 3 ++- .../tests/typed-racket/unit-tests/interactive-tests.rkt | 5 +++++ .../tests/typed-racket/unit-tests/typecheck-tests.rkt | 5 +++++ 4 files changed, 14 insertions(+), 2 deletions(-) diff --git a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/tc-let-unit.rkt b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/tc-let-unit.rkt index b47e7e86..4b6014c9 100644 --- a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/tc-let-unit.rkt +++ b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/tc-let-unit.rkt @@ -218,7 +218,8 @@ (cond [(null? clauses) (k)] [else (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 (lambda (e) (tc-expr/maybe-expected/t e names)) tc-expr/check)) diff --git a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/tc-toplevel.rkt b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/tc-toplevel.rkt index 431ed3c0..cb1f0f53 100644 --- a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/tc-toplevel.rkt +++ b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/tc-toplevel.rkt @@ -174,7 +174,8 @@ ;; the module (hence we haven't synthesized a type for yet). [_ (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)]) (register-type i t) (free-id-table-set! unann-defs i #t) diff --git a/pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/unit-tests/interactive-tests.rkt b/pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/unit-tests/interactive-tests.rkt index e30068a3..a8565fc8 100644 --- a/pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/unit-tests/interactive-tests.rkt +++ b/pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/unit-tests/interactive-tests.rkt @@ -114,6 +114,11 @@ (test-form-exn #rx"either undefined or missing a type annotation" (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" (:type 1)) (test-form (regexp-quote "(U Positive-Byte Zero)") 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 9cb6f3f6..d14b8b69 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 @@ -3275,6 +3275,11 @@ (tr:define (foo) : (Values String String) (values "foo" "bar")) (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