Checker/patterns: recover on unifying union types (#16393)

* Checker/patterns: recover on unifying union types

* Update baselines

* Baselines

* Baselines

* Disable test on desktop due to wrong line separators

src/Compiler/Checking/CheckPatterns.fs

@@ -579,9 +579,14 @@ and ApplyUnionCaseOrExn m (cenv: cenv) env overallTy item =
         CheckUnionCaseAccessible cenv.amap m ad ucref |> ignore
         let resTy = actualResultTyOfUnionCase ucinfo.TypeInst ucref
         let inst = mkTyparInst ucref.TyconRef.TyparsNoRange ucinfo.TypeInst
-        UnifyTypes cenv env m overallTy resTy
-        let mkf mArgs args = TPat_unioncase(ucref, ucinfo.TypeInst, args, unionRanges m mArgs)
-        mkf, actualTysOfUnionCaseFields inst ucref, [ for f in ucref.AllFieldsAsList -> f]
+        let mkf =
+            try
+                UnifyTypes cenv env m overallTy resTy
+                fun mArgs args -> TPat_unioncase(ucref, ucinfo.TypeInst, args, unionRanges m mArgs)
+            with RecoverableException e ->
+                errorRecovery e m
+                fun _ _ -> TPat_error m
+        mkf, actualTysOfUnionCaseFields inst ucref, [ for f in ucref.AllFieldsAsList -> f ]
 
     | _ ->
         invalidArg "item" "not a union case or exception reference"

tests/FSharp.Compiler.ComponentTests/Conformance/Expressions/ObjectExpressions/ObjectExpressions.fs

@@ -116,12 +116,20 @@ let implSomeDU =
          |> typecheck
          |> shouldFail
          |> withDiagnostics [
-            (Error 1, Line 31, Col 15, Line 31, Col 18, "This expression was expected to have type
+            Error 1, Line 31, Col 15, Line 31, Col 18, "This expression was expected to have type
     'AsString'    
 but here has type
-    'SomeDu'    ")
-         ]
-
+    'SomeDu'    "
+            Error 1, Line 32, Col 15, Line 32, Col 18, "This expression was expected to have type
+    'AsString'    
+but here has type
+    'SomeDu'    "
+            Error 1, Line 33, Col 15, Line 33, Col 18, "This expression was expected to have type
+    'AsString'    
+but here has type
+    'SomeDu'    "
+            Warning 25, Line 30, Col 19, Line 30, Col 23, "Incomplete pattern matches on this expression."]
+
     [<Fact>]
     let ``Object expression implementing multiple interfaces`` () =
         Fsx """

tests/FSharp.Compiler.ComponentTests/Conformance/PatternMatching/ConsList/ConsList.fs

@@ -25,10 +25,14 @@ module ConsList =
         |> typecheck
         |> shouldFail
         |> withDiagnostics [
-            (Error 1, Line 4, Col 21, Line 4, Col 28, "This expression was expected to have type
+            Error 1, Line 4, Col 21, Line 4, Col 28, "This expression was expected to have type
     'int'    
 but here has type
-    ''a list'    ")
+    ''a list'    "
+            Error 1, Line 5, Col 21, Line 5, Col 33, "This expression was expected to have type
+    'int'    
+but here has type
+    ''a list'    "
         ]
 
     // This test was automatically generated (moved from FSharpQA suite - Conformance/PatternMatching/ConsList)

tests/fsharp/typecheck/sigs/neg103.bsl

@@ -4,6 +4,8 @@ neg103.fs(7,12,7,22): typecheck error FS0001: This expression was expected to ha
 but here has type
     'string'    
 
+neg103.fs(11,5,11,11): typecheck error FS0025: Incomplete pattern matches on this expression.
+
 neg103.fs(12,7,12,15): typecheck error FS0001: This expression was expected to have type
     'int'    
 but here has type
@@ -14,14 +16,26 @@ neg103.fs(17,7,17,15): typecheck error FS0001: This expression was expected to h
 but here has type
     'MyUnion'    
 
+neg103.fs(12,18,12,23): typecheck error FS0001: This expression was expected to have type
+
+neg103.fs(12,26,12,34): typecheck error FS0001: This expression was expected to have type
+
+neg103.fs(15,5,15,11): typecheck error FS0025: Incomplete pattern matches on this expression.
+
 neg103.fs(21,7,21,9): typecheck error FS0001: This expression was expected to have type
     'Async<int>'    
 but here has type
     'int'    
 
 neg103.fs(20,5,20,11): typecheck error FS0025: Incomplete pattern matches on this expression.
 
+neg103.fs(24,9,24,15): typecheck error FS0025: Incomplete pattern matches on this expression.
+
 neg103.fs(25,11,25,19): typecheck error FS0001: This expression was expected to have type
     'int'    
 but here has type
     'MyUnion'    
+
+neg103.fs(25,22,25,27): typecheck error FS0001: This expression was expected to have type
+
+neg103.fs(25,30,25,38): typecheck error FS0001: This expression was expected to have type

tests/fsharp/typecheck/sigs/neg103.vsbsl

@@ -4,11 +4,19 @@ neg103.fs(7,12,7,22): typecheck error FS0001: This expression was expected to ha
 but here has type
     'string'    
 
+neg103.fs(11,5,11,11): typecheck error FS0025: Incomplete pattern matches on this expression.
+
 neg103.fs(12,7,12,15): typecheck error FS0001: This expression was expected to have type
     'int'    
 but here has type
     'MyUnion'    
 
+neg103.fs(12,18,12,23): typecheck error FS0001: This expression was expected to have type
+
+neg103.fs(12,26,12,34): typecheck error FS0001: This expression was expected to have type
+
+neg103.fs(15,5,15,11): typecheck error FS0025: Incomplete pattern matches on this expression.
+
 neg103.fs(17,7,17,15): typecheck error FS0001: This expression was expected to have type
     'int'    
 but here has type
@@ -21,7 +29,13 @@ but here has type
 
 neg103.fs(20,5,20,11): typecheck error FS0025: Incomplete pattern matches on this expression.
 
+neg103.fs(24,9,24,15): typecheck error FS0025: Incomplete pattern matches on this expression.
+
 neg103.fs(25,11,25,19): typecheck error FS0001: This expression was expected to have type
     'int'    
 but here has type
     'MyUnion'    
+
+neg103.fs(25,22,25,27): typecheck error FS0001: This expression was expected to have type
+
+neg103.fs(25,30,25,38): typecheck error FS0001: This expression was expected to have type

tests/service/PatternMatchCompilationTests.fs

@@ -187,6 +187,36 @@ match None with
     dumpDiagnostics checkResults |> shouldEqual [
     ]
 
+[<Test>]
+#if !NETCOREAPP
+[<Ignore("These tests weren't running on desktop and this test fails")>]
+#endif
+let ``Union case 10 - Wrong type`` () =
+    let _, checkResults = getParseAndCheckResults """
+match Some 1 with
+| Some(Some "") as a -> a |> ignore
+"""
+    assertHasSymbolUsages ["a"] checkResults
+    dumpDiagnostics checkResults |> shouldEqual [
+        "(3,7--3,14): This expression was expected to have type\u001d    'int'    \u001dbut here has type\u001d    ''a option'"
+        "(2,6--2,12): Incomplete pattern matches on this expression."
+    ]
+
+[<Test>]
+#if !NETCOREAPP
+[<Ignore("These tests weren't running on desktop and this test fails")>]
+#endif
+let ``Union case 11 - Wrong type`` () =
+    let _, checkResults = getParseAndCheckResults """
+match Some 1 with
+| Some(Some("", i)) as a -> a, i |> ignore
+"""
+    assertHasSymbolUsages ["a"; "i"] checkResults
+    dumpDiagnostics checkResults |> shouldEqual [
+        "(3,7--3,18): This expression was expected to have type\u001d    'int'    \u001dbut here has type\u001d    ''a option'";
+        "(2,6--2,12): Incomplete pattern matches on this expression."
+    ]
+
 [<Test>]
 #if !NETCOREAPP
 [<Ignore("These tests weren't running on desktop and this test fails")>]