From cdb8e9348adba7e8bbe71074039cad9f3055941d Mon Sep 17 00:00:00 2001 From: "Alexey.Berezhnykh" Date: Thu, 14 Aug 2025 21:46:29 +0300 Subject: [PATCH 1/6] wip --- src/Compiler/Checking/ConstraintSolver.fs | 6 ++++-- src/Compiler/Checking/ConstraintSolver.fsi | 4 ++-- .../ExtendedDiagnosticDataTests.fs | 19 +++++++++++++++++++ 3 files changed, 25 insertions(+), 4 deletions(-) diff --git a/src/Compiler/Checking/ConstraintSolver.fs b/src/Compiler/Checking/ConstraintSolver.fs index 1132eefa448..4b10ce50ffe 100644 --- a/src/Compiler/Checking/ConstraintSolver.fs +++ b/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 * TType * TType * range * range * ContextInfo +exception ConstraintSolverTypesNotInEqualityRelation of displayEnv: DisplayEnv * expectedTy: TType * actualTy: TType * range * range * ContextInfo exception ConstraintSolverTypesNotInSubsumptionRelation of displayEnv: DisplayEnv * argTy: TType * paramTy: TType * callRange: range * parameterRange: range @@ -1755,7 +1755,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 argTy2 argTy1 + do! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace argTy1 argTy2 do! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace retTy argTy1 return TTraitBuiltIn @@ -3171,6 +3171,8 @@ 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 diff --git a/src/Compiler/Checking/ConstraintSolver.fsi b/src/Compiler/Checking/ConstraintSolver.fsi index 4c29d684c31..f6ec661e239 100644 --- a/src/Compiler/Checking/ConstraintSolver.fsi +++ b/src/Compiler/Checking/ConstraintSolver.fsi @@ -104,8 +104,8 @@ exception ConstraintSolverInfiniteTypes of exception ConstraintSolverTypesNotInEqualityRelation of displayEnv: DisplayEnv * - TType * - TType * + expectedTy: TType * + actualTy: TType * range * range * ContextInfo diff --git a/tests/FSharp.Compiler.ComponentTests/ErrorMessages/ExtendedDiagnosticDataTests.fs b/tests/FSharp.Compiler.ComponentTests/ErrorMessages/ExtendedDiagnosticDataTests.fs index 1c6003de003..f2e2ad907b8 100755 --- a/tests/FSharp.Compiler.ComponentTests/ErrorMessages/ExtendedDiagnosticDataTests.fs +++ b/tests/FSharp.Compiler.ComponentTests/ErrorMessages/ExtendedDiagnosticDataTests.fs @@ -144,6 +144,25 @@ if true then 1 else "a" Assert.Equal("int", typeMismatch.ExpectedType.Format(displayContext)) Assert.Equal("string", typeMismatch.ActualType.Format(displayContext))) +[] +[] +[] +let ``TypeMismatchDiagnosticExtendedData 08`` code = + FSharp code + |> typecheckResults + |> checkDiagnostic + (1, "This expression was expected to have type\n 'string' \nbut here has type\n 'int' ") + (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))) + [] [] [] From 01192b136ffab46123b17f7c8607898aee3086d4 Mon Sep 17 00:00:00 2001 From: "Alexey.Berezhnykh" Date: Thu, 14 Aug 2025 22:31:32 +0300 Subject: [PATCH 2/6] temp CI fix --- src/Compiler/Checking/ConstraintSolver.fs | 2 +- src/Compiler/Facilities/DiagnosticsLogger.fs | 2 +- src/Compiler/TypedTree/TypedTree.fs | 2 +- 3 files changed, 3 insertions(+), 3 deletions(-) diff --git a/src/Compiler/Checking/ConstraintSolver.fs b/src/Compiler/Checking/ConstraintSolver.fs index 2877f65fffe..d49f54a2ba5 100644 --- a/src/Compiler/Checking/ConstraintSolver.fs +++ b/src/Compiler/Checking/ConstraintSolver.fs @@ -337,7 +337,7 @@ type ConstraintSolverEnv = member csenv.amap = csenv.SolverState.amap - override csenv.ToString() = " @ " + csenv.m.ToString() + override csenv.ToString() = " @ " + nonNull (csenv.m.ToString()) let MakeConstraintSolverEnv contextInfo css m denv = { SolverState = css diff --git a/src/Compiler/Facilities/DiagnosticsLogger.fs b/src/Compiler/Facilities/DiagnosticsLogger.fs index eb96a5f6e0b..f21dc927646 100644 --- a/src/Compiler/Facilities/DiagnosticsLogger.fs +++ b/src/Compiler/Facilities/DiagnosticsLogger.fs @@ -88,7 +88,7 @@ exception DiagnosticWithText of number: int * message: string * range: range wit exception InternalError of message: string * range: range with override this.Message = match this :> exn with - | InternalError(msg, m) -> msg + m.ToString() + | InternalError(msg, m) -> msg + nonNull (m.ToString()) | _ -> "impossible" exception InternalException of exn: Exception * msg: string * range: range with diff --git a/src/Compiler/TypedTree/TypedTree.fs b/src/Compiler/TypedTree/TypedTree.fs index 3efd889f57b..686e3763a25 100644 --- a/src/Compiler/TypedTree/TypedTree.fs +++ b/src/Compiler/TypedTree/TypedTree.fs @@ -5344,7 +5344,7 @@ type TOp = | Label n -> "Label(" + string n + ")" | TraitCall info -> "TraitCall(" + info.MemberLogicalName + ")" | LValueOp (op, vref) -> sprintf "%+A(%s)" op vref.LogicalName - | ILCall (_,_,_,_,_,_,_,ilMethRef,_,_,_) -> "ILCall(" + ilMethRef.ToString() + ",..)" + | ILCall (_,_,_,_,_,_,_,ilMethRef,_,_,_) -> "ILCall(" + nonNull (ilMethRef.ToString()) + ",..)" /// Represents the kind of record construction operation. type RecordConstructionInfo = From abced9359bd86f4f467a90c9e2e9a878a37e5e25 Mon Sep 17 00:00:00 2001 From: "Alexey.Berezhnykh" Date: Fri, 15 Aug 2025 01:33:31 +0300 Subject: [PATCH 3/6] wip --- src/Compiler/Checking/ConstraintSolver.fs | 6 ++--- src/Compiler/Checking/ConstraintSolver.fsi | 4 +-- src/Compiler/Symbols/FSharpDiagnostic.fs | 14 ++++++++--- .../ExtendedDiagnosticDataTests.fs | 25 +++++++++++++------ 4 files changed, 32 insertions(+), 17 deletions(-) diff --git a/src/Compiler/Checking/ConstraintSolver.fs b/src/Compiler/Checking/ConstraintSolver.fs index d49f54a2ba5..bfb27580d72 100644 --- a/src/Compiler/Checking/ConstraintSolver.fs +++ b/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 diff --git a/src/Compiler/Checking/ConstraintSolver.fsi b/src/Compiler/Checking/ConstraintSolver.fsi index f6ec661e239..4c29d684c31 100644 --- a/src/Compiler/Checking/ConstraintSolver.fsi +++ b/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 diff --git a/src/Compiler/Symbols/FSharpDiagnostic.fs b/src/Compiler/Symbols/FSharpDiagnostic.fs index 131e49845c3..3aa7a26ac42 100644 --- a/src/Compiler/Symbols/FSharpDiagnostic.fs +++ b/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)) diff --git a/tests/FSharp.Compiler.ComponentTests/ErrorMessages/ExtendedDiagnosticDataTests.fs b/tests/FSharp.Compiler.ComponentTests/ErrorMessages/ExtendedDiagnosticDataTests.fs index f2e2ad907b8..faf60bae063 100755 --- a/tests/FSharp.Compiler.ComponentTests/ErrorMessages/ExtendedDiagnosticDataTests.fs +++ b/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))) -[] -[] +let ``TypeMismatchDiagnosticExtendedData 08`` () = + FSharp """ type R = { Field1: int } let f (x: R) = "" + x.Field1 -""")>] -[ 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))) + +[] +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' ") From fe3439bd1173b11d40b7883435aef9b7f6addec7 Mon Sep 17 00:00:00 2001 From: "Alexey.Berezhnykh" Date: Fri, 15 Aug 2025 01:49:51 +0300 Subject: [PATCH 4/6] + test --- .../ErrorMessages/ExtendedDiagnosticDataTests.fs | 15 +++++++++++++++ 1 file changed, 15 insertions(+) diff --git a/tests/FSharp.Compiler.ComponentTests/ErrorMessages/ExtendedDiagnosticDataTests.fs b/tests/FSharp.Compiler.ComponentTests/ErrorMessages/ExtendedDiagnosticDataTests.fs index faf60bae063..e2615a4da62 100755 --- a/tests/FSharp.Compiler.ComponentTests/ErrorMessages/ExtendedDiagnosticDataTests.fs +++ b/tests/FSharp.Compiler.ComponentTests/ErrorMessages/ExtendedDiagnosticDataTests.fs @@ -172,6 +172,21 @@ let x: string = 1 Assert.Equal("string", typeMismatch.ExpectedType.Format(displayContext)) Assert.Equal("int", typeMismatch.ActualType.Format(displayContext))) +[] +let ``TypeMismatchDiagnosticExtendedData 10`` () = + FSharp """ +let f1 (x: outref<'T>) = 1 +let f2 (x: inref<'T>) = f1 &x +""" + |> typecheckResults + |> checkDiagnostic + (1, "Type mismatch. Expecting a\n 'outref<'T>' \nbut given a\n 'inref<'T>' \nThe type 'ByRefKinds.Out' does not match the type 'ByRefKinds.In'") + (fun (typeMismatch: TypeMismatchDiagnosticExtendedData) -> + let displayContext = typeMismatch.DisplayContext + Assert.Equal(DiagnosticContextInfo.NoContext, typeMismatch.ContextInfo) + Assert.Equal("outref<'T>", typeMismatch.ExpectedType.Format(displayContext)) + Assert.Equal("inref<'T>", typeMismatch.ActualType.Format(displayContext))) + [] [] [] From c0d87714eba3dc1e94140cb456349818bd0586aa Mon Sep 17 00:00:00 2001 From: "Alexey.Berezhnykh" Date: Fri, 15 Aug 2025 01:58:28 +0300 Subject: [PATCH 5/6] release notes --- docs/release-notes/.FSharp.Compiler.Service/10.0.100.md | 1 + 1 file changed, 1 insertion(+) diff --git a/docs/release-notes/.FSharp.Compiler.Service/10.0.100.md b/docs/release-notes/.FSharp.Compiler.Service/10.0.100.md index b69621fc796..f7f572652f7 100644 --- a/docs/release-notes/.FSharp.Compiler.Service/10.0.100.md +++ b/docs/release-notes/.FSharp.Compiler.Service/10.0.100.md @@ -21,6 +21,7 @@ * Fix SRTP nullness constraint resolution for types imported from older assemblies. AmbivalentToNull types now use legacy F# nullness rules instead of always satisfying `'T : null` constraints. ([Issue #18390](https://github.com/dotnet/fsharp/issues/18390), [Issue #18344](https://github.com/dotnet/fsharp/issues/18344)) * Fix Show XML doc for enum fields in external metadata ([Issue #17939](https://github.com/dotnet/fsharp/issues/17939#issuecomment-3137410105), [PR #18800](https://github.com/dotnet/fsharp/pull/18800)) +* TypeMismatchDiagnosticExtendedData: fix expected and actual types calculation. ([Issue ](https://github.com/dotnet/fsharp/pull/18851)) ### Changed * Use `errorR` instead of `error` in `CheckDeclarations.fs` when possible. ([PR #18645](https://github.com/dotnet/fsharp/pull/18645)) From 216f75c55a02d543d2a8100bbab4d1e29c0a53bf Mon Sep 17 00:00:00 2001 From: "Alexey.Berezhnykh" Date: Fri, 15 Aug 2025 14:39:51 +0300 Subject: [PATCH 6/6] Revert "temp CI fix" This reverts commit 01192b136ffab46123b17f7c8607898aee3086d4. --- src/Compiler/Checking/ConstraintSolver.fs | 2 +- src/Compiler/Facilities/DiagnosticsLogger.fs | 2 +- src/Compiler/TypedTree/TypedTree.fs | 2 +- 3 files changed, 3 insertions(+), 3 deletions(-) diff --git a/src/Compiler/Checking/ConstraintSolver.fs b/src/Compiler/Checking/ConstraintSolver.fs index bfb27580d72..a8389e6ad05 100644 --- a/src/Compiler/Checking/ConstraintSolver.fs +++ b/src/Compiler/Checking/ConstraintSolver.fs @@ -337,7 +337,7 @@ type ConstraintSolverEnv = member csenv.amap = csenv.SolverState.amap - override csenv.ToString() = " @ " + nonNull (csenv.m.ToString()) + override csenv.ToString() = " @ " + csenv.m.ToString() let MakeConstraintSolverEnv contextInfo css m denv = { SolverState = css diff --git a/src/Compiler/Facilities/DiagnosticsLogger.fs b/src/Compiler/Facilities/DiagnosticsLogger.fs index f21dc927646..eb96a5f6e0b 100644 --- a/src/Compiler/Facilities/DiagnosticsLogger.fs +++ b/src/Compiler/Facilities/DiagnosticsLogger.fs @@ -88,7 +88,7 @@ exception DiagnosticWithText of number: int * message: string * range: range wit exception InternalError of message: string * range: range with override this.Message = match this :> exn with - | InternalError(msg, m) -> msg + nonNull (m.ToString()) + | InternalError(msg, m) -> msg + m.ToString() | _ -> "impossible" exception InternalException of exn: Exception * msg: string * range: range with diff --git a/src/Compiler/TypedTree/TypedTree.fs b/src/Compiler/TypedTree/TypedTree.fs index 686e3763a25..3efd889f57b 100644 --- a/src/Compiler/TypedTree/TypedTree.fs +++ b/src/Compiler/TypedTree/TypedTree.fs @@ -5344,7 +5344,7 @@ type TOp = | Label n -> "Label(" + string n + ")" | TraitCall info -> "TraitCall(" + info.MemberLogicalName + ")" | LValueOp (op, vref) -> sprintf "%+A(%s)" op vref.LogicalName - | ILCall (_,_,_,_,_,_,_,ilMethRef,_,_,_) -> "ILCall(" + nonNull (ilMethRef.ToString()) + ",..)" + | ILCall (_,_,_,_,_,_,_,ilMethRef,_,_,_) -> "ILCall(" + ilMethRef.ToString() + ",..)" /// Represents the kind of record construction operation. type RecordConstructionInfo =