Wrong type is reported in type mismatch error

dotnet · Aug 7, 2022 · f0274f6 · f0274f6
1 parent 11692d9
commit f0274f6
Show file tree

Hide file tree

Showing 2 changed files with 29 additions and 13 deletions.
diff --git a/src/Compiler/Checking/ConstraintSolver.fs b/src/Compiler/Checking/ConstraintSolver.fs
@@ -1200,19 +1200,20 @@ and private SolveTypeEqualsTypeKeepAbbrevsWithCxsln csenv ndeep m2 trace cxsln t
         | LocallyAbortOperationThatLosesAbbrevs -> ErrorD(ConstraintSolverTypesNotInEqualityRelation(csenv.DisplayEnv, ty1, ty2, csenv.m, m2, csenv.eContextInfo))
         | err -> ErrorD err)
 
-and SolveTypeEqualsTypeEqns csenv ndeep m2 trace cxsln origl1 origl2 = 
-   match origl1, origl2 with 
-   | [], [] -> CompleteD 
-   | _ -> 
-       // We unwind Iterate2D by hand here for performance reasons.
-       let rec loop l1 l2 = 
-           match l1, l2 with 
-           | [], [] -> CompleteD 
-           | h1 :: t1, h2 :: t2 -> 
-               SolveTypeEqualsTypeKeepAbbrevsWithCxsln csenv ndeep m2 trace cxsln h1 h2 ++ (fun () -> loop t1 t2) 
-           | _ -> 
-               ErrorD(ConstraintSolverTupleDiffLengths(csenv.DisplayEnv, origl1, origl2, csenv.m, m2)) 
-       loop origl1 origl2
+and SolveTypeEqualsTypeEqns csenv ndeep m2 trace cxsln origl1 origl2 =
+    match origl1, origl2 with
+    | [], [] -> CompleteD 
+    | _ ->
+        // We unwind Iterate2D by hand here for performance reasons.
+        let rec loop l1 l2 = 
+            match l1, l2 with 
+            | [], [] -> CompleteD
+            | h1 :: t1, h2 :: t2 when t1.Length = t2.Length -> 
+                SolveTypeEqualsTypeKeepAbbrevsWithCxsln csenv ndeep m2 trace cxsln h1 h2 ++ (fun () -> loop t1 t2) 
+            | _ ->
+                // It would be better to have an instance of FSharpType contained in the error somehow but until it's not implemented it'd be good to report the correct type.
+                ErrorD(ConstraintSolverTupleDiffLengths(csenv.DisplayEnv, origl1, origl2, csenv.m, m2)) 
+        loop origl1 origl2
 
 and SolveFunTypeEqn csenv ndeep m2 trace cxsln domainTy1 domainTy2 rangeTy1 rangeTy2 = trackErrors {
     do! SolveTypeEqualsTypeKeepAbbrevsWithCxsln csenv ndeep m2 trace cxsln domainTy1 domainTy2

diff --git a/tests/FSharp.Compiler.ComponentTests/ErrorMessages/TypeMismatchTests.fs b/tests/FSharp.Compiler.ComponentTests/ErrorMessages/TypeMismatchTests.fs
@@ -7,6 +7,21 @@ open FSharp.Test.Compiler
 
 module ``Type Mismatch`` =
 
+    [<Fact>]
+    let ``type mistmach is reported when tupes have differing lenghts``() =
+        FSharp """
+ let x: int * int * int = 1, ""
+ let x: int * string * int = "", 1
+ let x: int * int = "", "", 1
+        """
+        |> typecheck
+        |> shouldFail
+        |> withDiagnostics [
+            (Error 1,  Line 2, Col 27, Line 2, Col 32, "Type mismatch. Expecting a\n    'int * int * int'    \nbut given a\n    ''a * 'b'    \nThe tuples have differing lengths of 3 and 2");
+            (Error 1,  Line 3, Col 30, Line 3, Col 35, "Type mismatch. Expecting a\n    'int * string * int'    \nbut given a\n    ''a * 'b'    \nThe tuples have differing lengths of 3 and 2");
+            (Error 1,  Line 4, Col 21, Line 4, Col 30, "Type mismatch. Expecting a\n    'int * int'    \nbut given a\n    ''a * 'b * 'c'    \nThe tuples have differing lengths of 2 and 3")
+        ]
+
     [<Fact>]
     let ``return Instead Of return!``() =
         FSharp """