diff --git a/collects/tests/typed-scheme/succeed/begin0-error.rkt b/collects/tests/typed-scheme/succeed/begin0-error.rkt new file mode 100644 index 00000000..b00b1c2a --- /dev/null +++ b/collects/tests/typed-scheme/succeed/begin0-error.rkt @@ -0,0 +1,21 @@ + +#lang typed/racket + +(define-type SN (U String Number)) + +(define-predicate sn? SN) + +(struct: (α) node ({left : α} {right : α})) + +(: create-node (Any Any -> String)) +(define (create-node x y) + (begin0 + "foo" + (unless #t + (error 'bad "")))) + +(: create-node2 (All (B) (B B -> (node SN)))) +(define (create-node2 x y) + (if (and (sn? x) (sn? y)) + (node x y) + (error 'bad ""))) \ No newline at end of file diff --git a/collects/typed-scheme/typecheck/tc-expr-unit.rkt b/collects/typed-scheme/typecheck/tc-expr-unit.rkt index c8eec5d6..ff1cb31b 100644 --- a/collects/typed-scheme/typecheck/tc-expr-unit.rkt +++ b/collects/typed-scheme/typecheck/tc-expr-unit.rkt @@ -13,7 +13,7 @@ (env lexical-env type-env-structs tvar-env index-env) racket/private/class-internal (except-in syntax/parse id) - unstable/function + unstable/function #;unstable/debug (only-in srfi/1 split-at)) (require (for-template scheme/base racket/private/class-internal)) @@ -236,7 +236,8 @@ ;; the argument must be syntax (unless (syntax? form) (int-err "bad form input to tc-expr: ~a" form)) - (let (;; a local version of ret that does the checking + (let ([old-ret ret] + ;; a local version of ret that does the checking [ret (lambda args (define te (apply ret args)) @@ -292,7 +293,7 @@ ;; begin [(begin e . es) (tc-exprs/check (syntax->list #'(e . es)) expected)] [(begin0 e . es) - (begin (tc-exprs/check (syntax->list #'es) Univ) + (begin (tc-exprs/check (syntax->list #'es) (old-ret Univ)) (tc-expr/check #'e expected))] ;; if [(if tst thn els) (tc/if-twoarm #'tst #'thn #'els expected)]