From 59bf67e8bfd03e9fe3253bc6130f9641a78c4b59 Mon Sep 17 00:00:00 2001
From: Eric Dobson <eric.n.dobson@gmail.com>
Date: Tue, 6 May 2014 22:42:26 -0700
Subject: [PATCH] Fix check-subforms and reenable TR contracts.

original commit: 0ba8cd9586666ee37397b525bc4c127710e81542
---
 .../typed-racket/typecheck/check-below.rkt                | 4 ++--
 .../typed-racket/typecheck/check-subforms-unit.rkt        | 5 +++--
 .../typed-racket/typecheck/signatures.rkt                 | 8 ++++----
 .../typed-racket/typecheck/tc-expr-unit.rkt               | 2 +-
 .../tests/typed-racket/unit-tests/typecheck-tests.rkt     | 6 ++++++
 5 files changed, 16 insertions(+), 9 deletions(-)

diff --git a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/check-below.rkt b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/check-below.rkt
index cc4df2a5..dcf6f40f 100644
--- a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/check-below.rkt
+++ b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/check-below.rkt
@@ -9,9 +9,9 @@
          (only-in (types printer) pretty-format-type))
 
 (provide/cond-contract
- [check-below (-->i ([s (-or/c Type/c tc-results/c)]
+ [check-below (-->i ([s (-or/c Type/c full-tc-results/c)]
                      [t (s) (if (Type/c? s) Type/c tc-results/c)])
-                    [_ (s) (if (Type/c? s) Type/c tc-results/c)])]
+                    [_ (s) (if (Type/c? s) Type/c full-tc-results/c)])]
  [cond-check-below (-->i ([s (-or/c Type/c full-tc-results/c)]
                           [t (s) (-or/c #f (if (Type/c? s) Type/c tc-results/c))])
                          [_ (s) (-or/c #f (if (Type/c? s) Type/c full-tc-results/c))])]
diff --git a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/check-subforms-unit.rkt b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/check-subforms-unit.rkt
index 5b6542ce..c351c4ef 100644
--- a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/check-subforms-unit.rkt
+++ b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/check-subforms-unit.rkt
@@ -90,6 +90,7 @@
 
 ;; syntax tc-results -> tc-results
 (define (check-subforms/with-handlers/check form expected)
+  (define body-results #f)
   (find-syntax form
     ;; if this needs to be checked
     [stx:with-type^
@@ -100,8 +101,8 @@
      (tc-expr/check #'stx (ret (-> (Un) (tc-results->values expected))))]
     ;; this is the body of the with-handlers
     [stx:exn-body^
-     (tc-expr/check #'stx expected)])
-  expected)
+     (set! body-results (tc-expr/check #'stx expected))])
+  body-results)
 
 ;; typecheck the expansion of a with-handlers form
 ;; syntax -> void
diff --git a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/signatures.rkt b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/signatures.rkt
index 3aedd593..6a6a7b49 100644
--- a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/signatures.rkt
+++ b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/signatures.rkt
@@ -7,7 +7,7 @@
 
 (define-signature tc-expr^
   ([cond-contracted tc-expr (syntax? . -> . full-tc-results/c)]
-   [cond-contracted tc-expr/check (syntax? tc-results/c . -> . tc-results/c)]
+   [cond-contracted tc-expr/check (syntax? tc-results/c . -> . full-tc-results/c)]
    [cond-contracted tc-expr/check/t (syntax? tc-results/c . -> . Type/c)]
    [cond-contracted tc-body (syntax? . -> . full-tc-results/c)]
    [cond-contracted tc-body/check (syntax? tc-results/c . -> . full-tc-results/c)]
@@ -15,9 +15,9 @@
    [cond-contracted single-value ((syntax?) ((or/c tc-results/c #f)) . ->* . full-tc-results/c)]))
 
 (define-signature check-subforms^
-  ([cond-contracted check-subforms/ignore (syntax? . -> . any)]
-   [cond-contracted check-subforms/with-handlers (syntax? . -> . any)]
-   [cond-contracted check-subforms/with-handlers/check (syntax? tc-results/c . -> . any)]))
+  ([cond-contracted check-subforms/ignore (syntax? . -> . void?)]
+   [cond-contracted check-subforms/with-handlers (syntax? . -> . full-tc-results/c)]
+   [cond-contracted check-subforms/with-handlers/check (syntax? tc-results/c . -> . full-tc-results/c)]))
 
 (define-signature check-class^
   ([cond-contracted check-class (syntax? (or/c tc-results/c #f) . -> . full-tc-results/c)]))
diff --git a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/tc-expr-unit.rkt b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/tc-expr-unit.rkt
index 00210300..97cbf3f9 100644
--- a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/tc-expr-unit.rkt
+++ b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/tc-expr-unit.rkt
@@ -86,7 +86,7 @@
 
 ;; tc-expr/check : syntax tc-results -> tc-results
 (define/cond-contract (tc-expr/check/internal form expected)
-  (--> syntax? tc-results/c tc-results/c)
+  (--> syntax? tc-results/c full-tc-results/c)
   (parameterize ([current-orig-stx form])
     ;(printf "form: ~a\n" (syntax-object->datum form))
     ;; the argument must be syntax
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 8b28260b..a8f8bd84 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
@@ -2910,6 +2910,12 @@
          (ann (for/list ([z #"foobar"]) (add1 z)) (Listof Integer))
          (-lst -Int)]
 
+       [tc-e
+         (with-handlers ([exn:fail? (λ (exn) 4)])
+            5)
+         #:ret (ret -Nat -true-filter)
+         #:expected (ret -Nat -no-filter)]
+
         )
   (test-suite
    "tc-literal tests"