diff --git a/collects/tests/typed-scheme/unit-tests/typecheck-tests.ss b/collects/tests/typed-scheme/unit-tests/typecheck-tests.ss
index 8f48407f..3488c93b 100644
--- a/collects/tests/typed-scheme/unit-tests/typecheck-tests.ss
+++ b/collects/tests/typed-scheme/unit-tests/typecheck-tests.ss
@@ -787,6 +787,10 @@
                     (+ 1 (car l))
                     7))
               -Number]
+        (tc-e (or (string->number "7") 7) 
+              #:ret (ret -Number (-FS (list) (list (make-Bot)))))
+        [tc-e (let ([x 1]) (if x x (add1 x))) 
+              #:ret (ret -Pos (-FS (list) (list (make-Bot))))]
         )
   (test-suite
    "check-type tests"
diff --git a/collects/typed-scheme/typecheck/tc-expr-unit.ss b/collects/typed-scheme/typecheck/tc-expr-unit.ss
index 3294ca26..6121a49f 100644
--- a/collects/typed-scheme/typecheck/tc-expr-unit.ss
+++ b/collects/typed-scheme/typecheck/tc-expr-unit.ss
@@ -4,10 +4,11 @@
 (require (rename-in "../utils/utils.ss" [private private-in]))
 (require syntax/kerncase mzlib/trace
          scheme/match (prefix-in - scheme/contract)
-         "signatures.ss"
-         (types utils convenience union subtype)
+         "signatures.ss" "tc-envops.ss" "tc-metafunctions.ss"
+         (types utils convenience union subtype remove-intersect)
          (private-in parse-type type-annotation)
          (rep type-rep)
+         (only-in (infer infer) restrict)
          (except-in (utils tc-utils stxclass-util))
          (env lexical-env)
          (only-in (env type-environments) lookup current-tvars extend-env)
@@ -249,6 +250,22 @@
             [checked? expected]
             [else (tc-expr/check/internal form expected)]))))
 
+(define (tc-or e1 e2 or-part [expected #f])
+  (match (single-value e1)
+    [(tc-result1: t1 (and f1 (FilterSet: fs+ fs-)) o1)
+     (let*-values ([(flag+ flag-) (values (box #t) (box #t))])
+       (match-let* ([(tc-result1: t2 f2 o2) (with-lexical-env 
+                                             (env+ (lexical-env) fs+ flag+) 
+                                             (with-lexical-env/extend 
+                                              (list or-part) (list (restrict t1 (-val #f))) (single-value e2 expected)))]
+                    [t1* (remove t1 (-val #f))]
+                    [f1* (-FS fs+ (list (make-Bot)))])
+         ;; if we have the same number of values in both cases
+         (let ([r (combine-filter f1 f1* f2 t1* t2 o1 o2)])
+           (if expected 
+               (check-below r expected)
+               r))))]))
+
 ;; tc-expr/check : syntax tc-results -> tc-results
 (define (tc-expr/check/internal form expected)
   (parameterize ([current-orig-stx form])
@@ -325,13 +342,14 @@
            (let-values (((_ _) (#%plain-app find-method/who _ rcvr _)))
              (#%plain-app _ _ args ...)))
          (tc/send #'rcvr #'meth #'(args ...) expected)]
-        ;; let
+        ;; or
         [(let-values ([(or-part) e1]) (if op1 op2 e2))
          (and 
           (identifier? #'op1) (identifier? #'op2)
           (free-identifier=? #'or-part #'op1)
           (free-identifier=? #'or-part #'op2))
-         (tc-expr/check #'(if e1 e1 (let-values ([(or-part) e1]) e2)) expected)]
+         (tc-or #'e1 #'e2 #'or-part expected)]
+        ;; let
         [(let-values ([(name ...) expr] ...) . body)
          (tc/let-values #'((name ...) ...) #'(expr ...) #'body form expected)]
         [(letrec-values ([(name) expr]) name*)
@@ -393,12 +411,13 @@
          (let-values (((_ _) (#%plain-app find-method/who _ rcvr _)))
            (#%plain-app _ _ args ...)))
        (tc/send #'rcvr #'meth #'(args ...))]
-      ;; let
+      ;; or
       [(let-values ([(or-part) e1]) (if op1 op2 e2))
        (and (identifier? #'op1) (identifier? #'op2)
             (free-identifier=? #'or-part #'op1)
             (free-identifier=? #'or-part #'op2))
-       (tc-expr #'(if e1 e1 (let-values ([(or-part) e1]) e2)))]
+       (tc-or #'e1 #'e2 #'or-part)]
+      ;; let
       [(let-values ([(name ...) expr] ...) . body)
        (tc/let-values #'((name ...) ...) #'(expr ...) #'body form)]
       [(letrec-values ([(name ...) expr] ...) . body)