Fix checking of (list ...) w/ union expected type

Closes PR 14758
Closes PR 14747

original commit: 5138614abacb7309213e772fe3701a8c9c882f37

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

@@ -8,7 +8,9 @@
 (define-signature tc-expr^
   ([cond-contracted tc-expr (syntax? . -> . full-tc-results/c)]
    [cond-contracted tc-expr/check (syntax? (or/c tc-results/c #f) . -> . full-tc-results/c)]
+   [cond-contracted tc-expr/check? (syntax? (or/c tc-results/c #f) . -> . (or/c full-tc-results/c #f))]
    [cond-contracted tc-expr/check/t (syntax? tc-results/c . -> . Type/c)]
+   [cond-contracted tc-expr/check/t? (syntax? (or/c tc-results/c #f) . -> . (or/c Type/c #f))]
    [cond-contracted tc-body/check (syntax? (or/c tc-results/c #f) . -> . full-tc-results/c)]
    [cond-contracted tc-expr/t (syntax? . -> . Type/c)]
    [cond-contracted single-value ((syntax?) ((or/c tc-results/c #f)) . ->* . full-tc-results/c)]))

pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/tc-app/tc-app-list.rkt

@@ -93,9 +93,9 @@
           [_ #f]))
       (ret (-Tuple
              (for/list ([i (in-syntax #'args)] [v (in-list vs)])
-                (if subst
-                    (tc-expr/check/t i (ret (subst-all subst (make-F v))))
-                    (tc-expr/t i)))))))
+               (or (and subst
+                        (tc-expr/check/t? i (ret (subst-all subst (make-F v)))))
+                   (tc-expr/t i)))))))
   ;; special case for `list*'
   (pattern (list* (~between args:expr 1 +inf.0) ...)
     (match-let* ([(list tys ... last) (stx-map tc-expr/t #'(args ...))])

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

@@ -76,6 +76,23 @@
     (add-typeof-expr form t)
     (cond-check-below t expected)))
 
+;; typecheck and return a truth value indicating a typecheck failure (#f)
+;; or success (any non-#f value)
+(define (tc-expr/check? form expected)
+  (parameterize ([current-type-error? #f])
+    (with-handlers ([exn:fail:syntax? (λ (_) #f)])
+      (dynamic-wind
+        (λ () (save-errors!))
+        (λ ()
+          (let ([result (tc-expr/check form expected)])
+            (and (not (current-type-error?)) result)))
+        (λ () (restore-errors!))))))
+
+(define (tc-expr/check/t? form expected)
+  (match (tc-expr/check? form expected)
+    [(tc-result1: t) t]
+    [#f #f]))
+
 (define (explicit-fail stx msg var)
   (cond [(and (identifier? var) (lookup-type/lexical var #:fail (λ _ #f)))
          =>

pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/utils/tc-utils.rkt

@@ -14,6 +14,7 @@ don't depend on any other portion of the system
          current-orig-stx
          orig-module-stx
          expanded-module-stx
+         current-type-error?
          print-syntax?
          warn-unreachable?
          delay-errors?
@@ -23,6 +24,8 @@ don't depend on any other portion of the system
          locate-stx
          warn-unreachable
 
+         save-errors!
+         restore-errors!
          reset-errors!
          report-first-error
          report-all-errors
@@ -46,6 +49,10 @@ don't depend on any other portion of the system
 (define orig-module-stx (make-parameter #f))
 (define expanded-module-stx (make-parameter #f))
 
+;; a parameter that represents whether a type error has occurred (#t) or
+;; not (#f) in the current dynamic extent
+(define current-type-error? (make-parameter #f))
+
 (define (stringify l [between " "])
   (define (intersperse v l)
     (cond [(null? l) null]
@@ -185,6 +192,7 @@ don't depend on any other portion of the system
     (unless (syntax? stx)
       (int-err "erroneous syntax was not a syntax object: ~a ~a"
                stx (syntax->datum stx*)))
+    (current-type-error? #t)
     (if (delay-errors?)
         (set! delayed-errors (cons (make-err (apply format msg rest)
                                              (list stx))
@@ -224,6 +232,7 @@ don't depend on any other portion of the system
   (let* ([ostx (current-orig-stx)]
          [ostxs (if (list? ostx) ostx (list ostx))]
          [stxs (map locate-stx ostxs)])
+    (current-type-error? #t)
     ;; If this isn't original syntax, then we can get some pretty bogus error
     ;; messages.  Note that this is from a macro expansion, so that introduced
     ;; vars and such don't confuse the user.

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

@@ -1436,7 +1436,7 @@
                           (init-rest [rst : (List Symbol)])))
              (make-object c% "wrong"))
            #:ret (ret (make-Instance (make-Class #f null null null null (-Tuple (list -Symbol)))))
-           #:msg #rx"expected: Symbol.*given: String"]
+           #:msg #rx"expected: \\(List Symbol.*given: \\(List String"]
    ;; PR 14408, test init-field order
    [tc-e (let ()
            (define c%

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

@@ -3293,6 +3293,26 @@
        ;; don't produce an internal error
        [tc-err (let () (define x (values 1 2)) (error "dummy"))
                #:msg #rx"Expression should produce 1 values"]
+
+       ;; PR 14758
+       [tc-e (ann (list 'change-size 30)
+                  (U (List 'change-family Symbol)
+                     (List 'change-size Byte)))
+             (t:Un (-lst* (-val 'change-family) -Symbol)
+                   (-lst* (-val 'change-size) -Byte))]
+
+       ;; PR 14747
+       [tc-e (let ()
+               (define-type-alias XExpr
+                 (U String Symbol Char
+                    (Pairof Symbol (Pairof (Listof (List Symbol String)) (Listof XExpr)))
+                    (Pairof Symbol (Listof XExpr))))
+               (: bug XExpr)
+               (define bug
+                 (let: ([elem : XExpr "some xexpr"])
+                   `(li ,elem)))
+               (void))
+             -Void]
         )
 
   (test-suite