Remove distinction between check and non check variant of check-subforms-unit.

Use new merge-tc-results as well.
This revealed some buggy tests as well which are also fixed.

original commit: 17c43c35ec371d17e0a1f52ba7f78cd32fc51ae9

pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/check-subforms-unit.rkt

@@ -21,19 +21,6 @@
 ;; get called with the wrong kind of arguments by the exception
 ;; mechanism.  The right thing is to use the exception predicate.
 
-(define (transpose l) (apply map list l))
-
-;; combine-types : Values * -> tc-results
-(define (combine-types . args)
-  (match args
-    [(list (tc-results: tss) ...)
-     (unless (apply = (map length tss))
-       (tc-error "Exception handlers and body did not all have the same number of results: ~a" (map length tss)))
-     ;; transpose and union
-     (let ([ts* (transpose tss)])
-       (ret (map (lambda (ts) (apply Un ts)) ts*)))]
-    [_ (int-err "Internal error: unsupported exception result type in: ~a" args)]))
-
 ;; Does a depth first search of the syntax object. For each sub object it attempts to match it
 ;; against the provide syntax-parse patterns.
 (define-syntax find-syntax
@@ -52,15 +39,14 @@
              [_ (void)])))]))
 
 ;; find the subexpressions that need to be typechecked in an ignored form
-;; syntax -> any
-(define (check-subforms/with-handlers form [expected #f])
-  (define handler-tys '())
-  (define body-ty #f)
-  (define body-stx #f)
+;; syntax (or/c #f tc-results/c) -> full-tc-results/c
+(define (check-subforms/with-handlers form expected)
+  (define handler-results '())
+  (define body-results #f)
   ;; tc-result1 -> tc-results
   ;; The result of applying the function to a single argument of the type of its first argument
   ;; FIXME: This is the wrong type, see above fixme
-  (define (get-result-ty t)
+  (define (get-range-result t)
     (let loop ((t t))
       (match t
         [(Function: (list _ ... (arr: (list arg1) _ _ #f (list (Keyword: _ _ #f) ...)) _ ...))
@@ -81,28 +67,11 @@
     [stx:exn-handler^
      (match (single-value #'stx)
        [(tc-result1: t)
-        (set! handler-tys (cons (get-result-ty t) handler-tys))])]
-    ;; this is the body of the with-handlers
-    [stx:exn-body^
-     (set! body-stx #'stx)
-     (set! body-ty (tc-expr #'stx))])
-  (apply combine-types body-ty handler-tys))
-
-;; 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^
-     ;; the form should be already ascribed the relevant type
-     (tc-expr #'stx)]
-    ;; this is a handler function
-    [stx:exn-handler^
-     (tc-expr/check #'stx (ret (-> (Un) (tc-results->values expected))))]
+        (set! handler-results (cons (get-range-result t) handler-results))])]
     ;; this is the body of the with-handlers
     [stx:exn-body^
      (set! body-results (tc-expr/check #'stx expected))])
-  body-results)
+  (merge-tc-results (cons body-results handler-results)))
 
 ;; typecheck the expansion of a with-handlers form
 ;; syntax -> void

pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/signatures.rkt

@@ -15,8 +15,7 @@
 
 (define-signature check-subforms^
   ([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)]))
+   [cond-contracted check-subforms/with-handlers (syntax? (or/c tc-results/c #f) . -> . full-tc-results/c)]))
 
 (define-signature check-class^
   ([cond-contracted check-class (syntax? (or/c tc-results/c #f) . -> . full-tc-results/c)]))

pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/tc-expr-unit.rkt

@@ -91,9 +91,7 @@
        (check-class form expected)]
       [stx:exn-handlers^
        (register-ignored! form)
-       (if expected
-           (check-subforms/with-handlers/check form expected)
-           (check-subforms/with-handlers form))]
+       (check-subforms/with-handlers form expected) ]
       ;; explicit failure
       [t:typecheck-failure
        (explicit-fail #'t.stx #'t.message #'t.var)]

pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/optimizer/tests/vector-length-impersonator.rkt

@@ -16,7 +16,7 @@ END
 
 ;; should error
 (with-handlers ([exn:fail:contract?
-                 (lambda (e)
+                 (lambda: ([e : exn])
                    (when (regexp-match "index is out of range for empty vector"
                                        (exn-message e))
                      (display "passed\n")))])

pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/succeed/pr12644.rkt

@@ -7,13 +7,11 @@
 (: g (All (x) (x -> x)))
 (define (g x) x)
 
-(: v (Listof (U inf Byte)))
+(: v (Listof (U inf Number)))
 (define v
   (list
-    (with-handlers ((void values)) 2)
     (with-handlers ((void add1)) 3)
-    (with-handlers ((void f)) 4)
-    (with-handlers ((void g)) 5)))
+    (with-handlers ((void f)) 4)))
 
 
 (list

pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/unit-tests/special-env-typecheck-tests.rkt

@@ -118,7 +118,8 @@
 
    ;; exception handling
    [tc-e (with-handlers ([void (λ (x) (values 0 0))]) (values  "" ""))
-         #:ret (ret (list (t:Un -Zero -String) (t:Un -Zero -String)))]
+         #:ret (ret (list (t:Un -Zero -String) (t:Un -Zero -String))
+                    (list -true-filter -true-filter))]
 
    (tc-e (make-temporary-file) -Path)
    (tc-e (make-temporary-file "ee~a") -Path)

pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/unit-tests/typecheck-tests.rkt

@@ -2947,6 +2947,12 @@
          #:ret (ret -Nat -true-filter)
          #:expected (ret -Nat -no-filter)]
 
+       [tc-e
+         (with-handlers ([exn:fail? (λ (exn) #f)])
+            5)
+         #:ret (ret Univ -top-filter)
+         #:expected (ret Univ -no-filter)]
+
        [tc-e
          (lambda (a . b) (apply values a b))