wip

Author: DedSec256

src/Compiler/Checking/ConstraintSolver.fs

@@ -216,7 +216,7 @@ exception ConstraintSolverTupleDiffLengths of displayEnv: DisplayEnv * contextIn
 
 exception ConstraintSolverInfiniteTypes of displayEnv: DisplayEnv * contextInfo: ContextInfo * TType * TType * range * range
 
-exception ConstraintSolverTypesNotInEqualityRelation of displayEnv: DisplayEnv * expectedTy: TType * actualTy: TType * range * range * ContextInfo
+exception ConstraintSolverTypesNotInEqualityRelation of displayEnv: DisplayEnv * TType * TType * range * range * ContextInfo
 
 exception ConstraintSolverTypesNotInSubsumptionRelation of displayEnv: DisplayEnv * argTy: TType * paramTy: TType * callRange: range * parameterRange: range
 
@@ -1756,7 +1756,7 @@ and SolveMemberConstraint (csenv: ConstraintSolverEnv) ignoreUnresolvedOverload
                             (minfos |> List.forall (fun (_, minfo) -> isIntegerTy g minfo.ApparentEnclosingType ) &&
                                 (   IsAddSubModType nm g argTy1 && IsBinaryOpOtherArgType g permitWeakResolution argTy2
                                 || IsAddSubModType nm g argTy2 && IsBinaryOpOtherArgType g permitWeakResolution argTy1)) -> 
-                        do! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace argTy1 argTy2
+                        do! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace argTy2 argTy1
                         do! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace retTy argTy1
                         return TTraitBuiltIn
 
@@ -3184,8 +3184,6 @@ and SolveTypeEqualsTypeWithReport (csenv: ConstraintSolverEnv) ndeep m trace cxs
         (fun () -> SolveTypeEqualsTypeKeepAbbrevsWithCxsln csenv ndeep m trace cxsln expectedTy actualTy)
         (function
         | AbortForFailedMemberConstraintResolution as err -> ErrorD err
-        | ConstraintSolverTypesNotInEqualityRelation(_, expectedTy, actualTy, _, _, _) as err ->
-            ErrorD (ErrorFromAddingTypeEquation(csenv.g, csenv.DisplayEnv, expectedTy, actualTy, err, m))
         | res -> ErrorD (ErrorFromAddingTypeEquation(csenv.g, csenv.DisplayEnv, expectedTy, actualTy, res, m)))
 
 and ArgsMustSubsumeOrConvert 

src/Compiler/Checking/ConstraintSolver.fsi

@@ -104,8 +104,8 @@ exception ConstraintSolverInfiniteTypes of
 
 exception ConstraintSolverTypesNotInEqualityRelation of
     displayEnv: DisplayEnv *
-    expectedTy: TType *
-    actualTy: TType *
+    TType *
+    TType *
     range *
     range *
     ContextInfo

src/Compiler/Symbols/FSharpDiagnostic.fs

@@ -9,7 +9,6 @@ namespace FSharp.Compiler.Diagnostics
 
 open System
 
-open FSharp.Compiler.AttributeChecking
 open FSharp.Compiler.CheckExpressions
 open FSharp.Compiler.ConstraintSolver
 open FSharp.Compiler.SignatureConformance
@@ -26,7 +25,6 @@ open FSharp.Compiler.CompilerDiagnostics
 open FSharp.Compiler.Diagnostics
 open FSharp.Compiler.DiagnosticsLogger
 open FSharp.Compiler.Text
-open FSharp.Compiler.Text.Position
 open FSharp.Compiler.Text.Range
 
 module ExtendedData =
@@ -199,11 +197,21 @@ type FSharpDiagnostic(m: range, severity: FSharpDiagnosticSeverity, message: str
 
             match diagnostic.Exception with
             | ErrorFromAddingTypeEquation(_, displayEnv, expectedType, actualType, ConstraintSolverTupleDiffLengths(contextInfo = contextInfo), _)
-            | ErrorFromAddingTypeEquation(_, displayEnv, expectedType, actualType, ConstraintSolverTypesNotInEqualityRelation(_, _, _, _, _, contextInfo), _)
             | ErrorsFromAddingSubsumptionConstraint(_, displayEnv, expectedType, actualType, _, contextInfo, _) ->
                let context = DiagnosticContextInfo.From(contextInfo)
                Some(TypeMismatchDiagnosticExtendedData(symbolEnv, displayEnv, expectedType, actualType, context))
 
+            | ErrorFromAddingTypeEquation(g, displayEnv, ty1, ty2, ConstraintSolverTypesNotInEqualityRelation(_, ty1b, ty2b, _, _, contextInfo), _) ->
+               let expectedType, actualType =
+                   if typeEquiv g ty1 ty1b && typeEquiv g ty2 ty2b then
+                       ty1, ty2
+                   elif not (typeEquiv g ty1 ty2) then
+                       ty1, ty2
+                   else ty2b, ty1b
+
+               let context = DiagnosticContextInfo.From(contextInfo)
+               Some(TypeMismatchDiagnosticExtendedData(symbolEnv, displayEnv, expectedType, actualType, context))
+
             | ErrorFromAddingTypeEquation(_, displayEnv, expectedType, actualType, _, _)->
                Some(TypeMismatchDiagnosticExtendedData(symbolEnv, displayEnv, expectedType, actualType, DiagnosticContextInfo.NoContext))
 

tests/FSharp.Compiler.ComponentTests/ErrorMessages/ExtendedDiagnosticDataTests.fs

@@ -4,7 +4,6 @@
 open FSharp.Compiler.Text
 open FSharp.Compiler.Diagnostics
 open FSharp.Compiler.Diagnostics.ExtendedData
-open FSharp.Test
 open FSharp.Test.Compiler
 open Xunit
 
@@ -144,16 +143,26 @@ if true then 1 else "a"
         Assert.Equal("int", typeMismatch.ExpectedType.Format(displayContext))
         Assert.Equal("string", typeMismatch.ActualType.Format(displayContext)))
 
-[<Theory>]
-[<InlineData("""
+[<Fact>]
+let ``TypeMismatchDiagnosticExtendedData 08`` () =
+    FSharp """
 type R = { Field1: int }
 let f (x: R) = "" + x.Field1
-""")>]
-[<InlineData("""
+"""
+    |> typecheckResults
+    |> checkDiagnostic
+       (1, "The type 'int' does not match the type 'string'")
+       (fun (typeMismatch: TypeMismatchDiagnosticExtendedData) ->
+        let displayContext = typeMismatch.DisplayContext
+        Assert.Equal(DiagnosticContextInfo.NoContext, typeMismatch.ContextInfo)
+        Assert.Equal("string", typeMismatch.ExpectedType.Format(displayContext))
+        Assert.Equal("int", typeMismatch.ActualType.Format(displayContext)))
+
+[<Fact>]
+let ``TypeMismatchDiagnosticExtendedData 09`` () =
+    FSharp """
 let x: string = 1
-""")>]
-let ``TypeMismatchDiagnosticExtendedData 08`` code =
-    FSharp code
+"""
     |> typecheckResults
     |> checkDiagnostic
        (1, "This expression was expected to have type\n    'string'    \nbut here has type\n    'int'    ")