From 6103fca21a9623e53ed7385fa3f65b8289bc1aae Mon Sep 17 00:00:00 2001 From: Tomas Grosup Date: Tue, 17 Feb 2026 12:01:54 +0100 Subject: [PATCH 1/6] fix after review feedback --- .../Checking/Expressions/CheckExpressions.fs | 7 +- src/Compiler/Checking/NameResolution.fs | 13 +- .../FSharp.Compiler.ComponentTests.fsproj | 1 + .../SemanticClassificationRegressions.fs | 118 ++++++++++++++++++ .../SemanticClassificationServiceTests.fs | 96 ++++++++++++++ 5 files changed, 228 insertions(+), 7 deletions(-) create mode 100644 tests/FSharp.Compiler.ComponentTests/FSharpChecker/SemanticClassificationRegressions.fs diff --git a/src/Compiler/Checking/Expressions/CheckExpressions.fs b/src/Compiler/Checking/Expressions/CheckExpressions.fs index 3d93b2c526d..9ff5b05fcb0 100644 --- a/src/Compiler/Checking/Expressions/CheckExpressions.fs +++ b/src/Compiler/Checking/Expressions/CheckExpressions.fs @@ -7841,10 +7841,13 @@ and TcRecdExpr cenv overallTy env tpenv (inherits, withExprOpt, synRecdFields, m UnifyTypes cenv env mWholeExpr overallTy gtyp // (#15290) For copy-and-update expressions, register the record type as a reference - // so that "Find All References" on the record type includes copy-and-update usages + // so that "Find All References" on the record type includes copy-and-update usages. + // Use a zero-width range at the start of the expression to avoid affecting semantic + // classification (coloring) of field names and other tokens within the expression. if hasOrigExpr then let item = Item.Types(tcref.DisplayName, [gtyp]) - CallNameResolutionSink cenv.tcSink (mWholeExpr, env.NameEnv, item, emptyTyparInst, ItemOccurrence.Use, env.eAccessRights) + let pointRange = Range.mkRange mWholeExpr.FileName mWholeExpr.Start mWholeExpr.Start + CallNameResolutionSink cenv.tcSink (pointRange, env.NameEnv, item, emptyTyparInst, ItemOccurrence.Use, env.eAccessRights) [ for n, v in fldsList do match v with diff --git a/src/Compiler/Checking/NameResolution.fs b/src/Compiler/Checking/NameResolution.fs index b89c6d91d13..6df34370038 100644 --- a/src/Compiler/Checking/NameResolution.fs +++ b/src/Compiler/Checking/NameResolution.fs @@ -2243,7 +2243,8 @@ let CallEnvSink (sink: TcResultsSink) (scopem, nenv, ad) = // (#16621) Register union case tester properties as references to their underlying union case. // For union case testers (e.g., IsB property), this ensures "Find All References" on a union case -// includes usages of its tester property. Uses a shifted range to avoid duplicate filtering in ItemKeyStore. +// includes usages of its tester property. Uses the identifier range computed from the end of the +// member access range to avoid coloring the dot in "x.IsA" as a union case. let RegisterUnionCaseTesterForProperty (sink: TcResultsSink) (m: range) @@ -2265,10 +2266,12 @@ let RegisterUnionCaseTesterForProperty let ucref = tcref.MakeNestedUnionCaseRef ucase let ucinfo = UnionCaseInfo([], ucref) let ucItem = Item.UnionCase(ucinfo, false) - // Shift start by 1 column to distinguish from the property reference - let shiftedStart = Position.mkPos m.StartLine (m.StartColumn + 1) - let shiftedRange = Range.withStart shiftedStart m - currentSink.NotifyNameResolution(shiftedRange.End, ucItem, emptyTyparInst, occurrenceType, nenv, ad, shiftedRange, false) + // Compute the range of just the property identifier (e.g., "IsA") from the end of the + // member access range, so it excludes any dot or qualifier prefix (e.g., "x." in "x.IsA"). + let propertyNameLength = 2 + caseName.Length // "Is" + caseName + let identStart = Position.mkPos m.EndLine (m.EndColumn - propertyNameLength) + let identRange = Range.mkRange m.FileName identStart m.End + currentSink.NotifyNameResolution(identRange.End, ucItem, emptyTyparInst, occurrenceType, nenv, ad, identRange, false) | None -> () | _ -> () diff --git a/tests/FSharp.Compiler.ComponentTests/FSharp.Compiler.ComponentTests.fsproj b/tests/FSharp.Compiler.ComponentTests/FSharp.Compiler.ComponentTests.fsproj index 63150ad3a7d..28ccff94df7 100644 --- a/tests/FSharp.Compiler.ComponentTests/FSharp.Compiler.ComponentTests.fsproj +++ b/tests/FSharp.Compiler.ComponentTests/FSharp.Compiler.ComponentTests.fsproj @@ -359,6 +359,7 @@ + diff --git a/tests/FSharp.Compiler.ComponentTests/FSharpChecker/SemanticClassificationRegressions.fs b/tests/FSharp.Compiler.ComponentTests/FSharpChecker/SemanticClassificationRegressions.fs new file mode 100644 index 00000000000..7a137396718 --- /dev/null +++ b/tests/FSharp.Compiler.ComponentTests/FSharpChecker/SemanticClassificationRegressions.fs @@ -0,0 +1,118 @@ +module FSharpChecker.SemanticClassificationRegressions + +open Xunit +open FSharp.Compiler.CodeAnalysis +open FSharp.Compiler.EditorServices +open FSharp.Compiler.Text +open FSharp.Test.ProjectGeneration +open FSharp.Test.ProjectGeneration.Helpers + +#nowarn "57" + +/// Get semantic classification items for a single-file source using the transparent compiler. +let getClassifications (source: string) = + let fileName, snapshot, checker = singleFileChecker source + let results = checker.ParseAndCheckFileInProject(fileName, snapshot) |> Async.RunSynchronously + let checkResults = getTypeCheckResult results + checkResults.GetSemanticClassification(None) + +/// (#15290 regression) Copy-and-update record fields must not be classified as type names. +/// Before the fix, Item.Types was registered with mWholeExpr and ItemOccurrence.Use, producing +/// a wide type classification that overshadowed the correct RecordField classification. +[] +let ``Copy-and-update field should not be classified as type name`` () = + let source = + """ +module Test + +type MyRecord = { ValidationErrors: string list; Name: string } +let x: MyRecord = { ValidationErrors = []; Name = "" } +let updated = { x with ValidationErrors = [] } +""" + + let items = getClassifications source + + // Line 6 contains "{ x with ValidationErrors = [] }" + // "ValidationErrors" starts around column 23 (after "let updated = { x with ") + // It should be RecordField, NOT ReferenceType/ValueType. + let fieldLine = 6 + + let fieldItems = + items + |> Array.filter (fun item -> + item.Range.StartLine = fieldLine + && item.Type = SemanticClassificationType.RecordField) + + Assert.True(fieldItems.Length > 0, "Expected RecordField classification on the copy-and-update line") + + // No type classification should cover the field name on that line with a visible range + let typeItemsCoveringField = + items + |> Array.filter (fun item -> + item.Range.StartLine <= fieldLine + && item.Range.EndLine >= fieldLine + && item.Range.Start <> item.Range.End + && (item.Type = SemanticClassificationType.ReferenceType + || item.Type = SemanticClassificationType.ValueType + || item.Type = SemanticClassificationType.Type)) + + Assert.True( + typeItemsCoveringField.Length = 0, + sprintf + "No type classification should cover the copy-and-update line, but found: %A" + (typeItemsCoveringField |> Array.map (fun i -> i.Range, i.Type)) + ) + +/// (#16621 regression) Union case tester classification must not include the dot. +/// Before the fix, RegisterUnionCaseTesterForProperty shifted m.Start by +1, +/// producing range ".IsCircle" whose dot survived fixupSpan. +[] +let ``Union case tester classification range should not include dot`` () = + let source = + """ +module Test + +type Shape = Circle | Square | HyperbolicCaseWithLongName +let s = Circle +let r1 = s.IsCircle +let r2 = s.IsHyperbolicCaseWithLongName +""" + + let items = getClassifications source + + // Find UnionCase classification items on lines 6 and 7 + let unionCaseItems = + items + |> Array.filter (fun item -> + item.Type = SemanticClassificationType.UnionCase + && (item.Range.StartLine = 6 || item.Range.StartLine = 7)) + + // There should be union case classifications for the tester properties + Assert.True( + unionCaseItems.Length > 0, + "Expected UnionCase classification for case tester properties" + ) + + // For each union case item, the range must NOT extend before the "Is" prefix. + // "s.IsCircle" — dot is at some column, "IsCircle" starts 1 column later. + // The union case range must start at or after the "Is" column. + for item in unionCaseItems do + // The range should cover at most the property name (e.g., "IsCircle" length 8) + // It should NOT start at or before the dot position. + let rangeWidth = item.Range.EndColumn - item.Range.StartColumn + + if item.Range.StartLine = 6 then + // "let r1 = s.IsCircle" — "IsCircle" has length 8 + // The dot is at column 11 (0-based: "let r1 = s" is 10 chars, dot at 10) + // "IsCircle" starts at column 11 (after the dot) + Assert.True( + rangeWidth <= 8, + sprintf "UnionCase range for IsCircle is too wide (%d columns): %A" rangeWidth item.Range + ) + + if item.Range.StartLine = 7 then + // "let r2 = s.IsHyperbolicCaseWithLongName" — property name length = 2 + 28 = 30 + Assert.True( + rangeWidth <= 30, + sprintf "UnionCase range for IsHyperbolicCaseWithLongName is too wide (%d columns): %A" rangeWidth item.Range + ) diff --git a/vsintegration/tests/FSharp.Editor.Tests/SemanticClassificationServiceTests.fs b/vsintegration/tests/FSharp.Editor.Tests/SemanticClassificationServiceTests.fs index b80956ddbc6..8d5a856c2e7 100644 --- a/vsintegration/tests/FSharp.Editor.Tests/SemanticClassificationServiceTests.fs +++ b/vsintegration/tests/FSharp.Editor.Tests/SemanticClassificationServiceTests.fs @@ -306,3 +306,99 @@ type TestType() = Assert.NotEqual(ClassificationTypeNames.ClassName, classificationType) Assert.NotEqual(ClassificationTypeNames.NamespaceName, classificationType) + + [] + member _.``Copy-and-update field should not be classified as type name``() = + let sourceText = + """ +type MyRecord = { ValidationErrors: string list; Name: string } +let x = { ValidationErrors = []; Name = "" } +let updated = { x with (*1*)ValidationErrors = [] } + +[] +type StructRecord = { Count: int; Label: string } +let sr = { Count = 0; Label = "" } +let sr2 = { sr with (*2*)Count = 1 } +""" + + let text = SourceText.From(sourceText) + let ranges = getRanges sourceText + + // DEBUG: Print all classifications around (*1*) + let line1 = text.Lines.GetLinePosition(sourceText.IndexOf("(*1*)") + 5) + let markerPos1 = Position.mkPos (Line.fromZ line1.Line) (line1.Character + 1) + + let overlappingRanges1 = + ranges + |> List.filter (fun item -> Range.rangeContainsPos item.Range markerPos1) + + printfn "=== Classifications overlapping with (*1*) at position %A ===" markerPos1 + for item in overlappingRanges1 do + let classificationType = FSharpClassificationTypes.getClassificationTypeName item.Type + printfn " Range: %A, Type: %s (%A)" item.Range classificationType item.Type + if List.isEmpty overlappingRanges1 then + printfn " (No classifications found)" + + // The field should be classified as PropertyName (RecordField), not as a type name. + // Before the fix, Item.Types was registered with mWholeExpr and ItemOccurrence.Use, + // causing the entire copy-and-update range to get a type classification that + // overshadowed the correct RecordField classification at the field position. + verifyClassificationAtEndOfMarker (sourceText, "(*1*)", ClassificationTypeNames.PropertyName) + verifyNoClassificationDataAtEndOfMarker (sourceText, "(*1*)", ClassificationTypeNames.ClassName) + // Also verify struct record copy-and-update + verifyClassificationAtEndOfMarker (sourceText, "(*2*)", ClassificationTypeNames.PropertyName) + verifyNoClassificationDataAtEndOfMarker (sourceText, "(*2*)", ClassificationTypeNames.StructName) + + [] + member _.``Union case tester property range should not include dot``() = + let sourceText = + """ +type Shape = Circle | Square | HyperbolicCaseWithLongName +let s = Circle +let result = s.(*1*)IsCircle +let result2 = s.(*2*)IsHyperbolicCaseWithLongName +""" + + let ranges = getRanges sourceText + let text = SourceText.From(sourceText) + + // Find the dot position in "s.IsCircle" + let dotIdx = sourceText.IndexOf("s.(*1*)IsCircle") + 1 + let dotLine = text.Lines.GetLinePosition(dotIdx) + let dotPos = Position.mkPos (Line.fromZ dotLine.Line) dotLine.Character + + // There should be a UnionCase (EnumName) classification covering IsCircle + let isCirclePos = + let idx = sourceText.IndexOf("(*1*)IsCircle") + "(*1*)".Length + let linePos = text.Lines.GetLinePosition(idx) + Position.mkPos (Line.fromZ linePos.Line) linePos.Character + + let unionCaseAtIdentifier = + ranges + |> List.filter (fun item -> + FSharpClassificationTypes.getClassificationTypeName item.Type = ClassificationTypeNames.EnumName + && Range.rangeContainsPos item.Range isCirclePos) + + Assert.True( + unionCaseAtIdentifier.Length > 0, + "Expected a UnionCase classification covering 'IsCircle'" + ) + + // No UnionCase classification should include the dot position. + // Before the fix, the identifier range was computed by shifting m.Start by +1, + // producing ".IsCircle" — the dot at index 0 survived fixupSpan and got UnionCase color. + let unionCaseAtDot = + ranges + |> List.filter (fun item -> + FSharpClassificationTypes.getClassificationTypeName item.Type = ClassificationTypeNames.EnumName + && Range.rangeContainsPos item.Range dotPos) + + Assert.True( + unionCaseAtDot.IsEmpty, + sprintf + "UnionCase classification should not include the dot, but found items with ranges: %A" + (unionCaseAtDot |> List.map (fun i -> i.Range)) + ) + + // Also verify the long case name + verifyClassificationAtEndOfMarker (sourceText, "(*2*)", ClassificationTypeNames.EnumName) From 5905c790649c2562113cbbe416e15ef33b1074b2 Mon Sep 17 00:00:00 2001 From: Tomas Grosup Date: Tue, 17 Feb 2026 15:08:19 +0100 Subject: [PATCH 2/6] fix CI: fantomas formatting + editor test assertion for overlapping classifications --- .../SemanticClassificationServiceTests.fs | 39 ++++++++++++------- 1 file changed, 26 insertions(+), 13 deletions(-) diff --git a/vsintegration/tests/FSharp.Editor.Tests/SemanticClassificationServiceTests.fs b/vsintegration/tests/FSharp.Editor.Tests/SemanticClassificationServiceTests.fs index 8d5a856c2e7..7338e794c8b 100644 --- a/vsintegration/tests/FSharp.Editor.Tests/SemanticClassificationServiceTests.fs +++ b/vsintegration/tests/FSharp.Editor.Tests/SemanticClassificationServiceTests.fs @@ -323,19 +323,22 @@ let sr2 = { sr with (*2*)Count = 1 } let text = SourceText.From(sourceText) let ranges = getRanges sourceText - + // DEBUG: Print all classifications around (*1*) let line1 = text.Lines.GetLinePosition(sourceText.IndexOf("(*1*)") + 5) let markerPos1 = Position.mkPos (Line.fromZ line1.Line) (line1.Character + 1) - - let overlappingRanges1 = - ranges - |> List.filter (fun item -> Range.rangeContainsPos item.Range markerPos1) - + + let overlappingRanges1 = + ranges |> List.filter (fun item -> Range.rangeContainsPos item.Range markerPos1) + printfn "=== Classifications overlapping with (*1*) at position %A ===" markerPos1 + for item in overlappingRanges1 do - let classificationType = FSharpClassificationTypes.getClassificationTypeName item.Type + let classificationType = + FSharpClassificationTypes.getClassificationTypeName item.Type + printfn " Range: %A, Type: %s (%A)" item.Range classificationType item.Type + if List.isEmpty overlappingRanges1 then printfn " (No classifications found)" @@ -379,10 +382,7 @@ let result2 = s.(*2*)IsHyperbolicCaseWithLongName FSharpClassificationTypes.getClassificationTypeName item.Type = ClassificationTypeNames.EnumName && Range.rangeContainsPos item.Range isCirclePos) - Assert.True( - unionCaseAtIdentifier.Length > 0, - "Expected a UnionCase classification covering 'IsCircle'" - ) + Assert.True(unionCaseAtIdentifier.Length > 0, "Expected a UnionCase classification covering 'IsCircle'") // No UnionCase classification should include the dot position. // Before the fix, the identifier range was computed by shifting m.Start by +1, @@ -400,5 +400,18 @@ let result2 = s.(*2*)IsHyperbolicCaseWithLongName (unionCaseAtDot |> List.map (fun i -> i.Range)) ) - // Also verify the long case name - verifyClassificationAtEndOfMarker (sourceText, "(*2*)", ClassificationTypeNames.EnumName) + // Also verify the long case name has a UnionCase (EnumName) classification. + // Use explicit filter instead of verifyClassificationAtEndOfMarker, because both + // Property and UnionCase classifications overlap at the same position. + let longCasePos = + let idx = sourceText.IndexOf("(*2*)IsHyperbolicCaseWithLongName") + "(*2*)".Length + let linePos = text.Lines.GetLinePosition(idx) + Position.mkPos (Line.fromZ linePos.Line) linePos.Character + + let longCaseUnionItems = + ranges + |> List.filter (fun item -> + FSharpClassificationTypes.getClassificationTypeName item.Type = ClassificationTypeNames.EnumName + && Range.rangeContainsPos item.Range longCasePos) + + Assert.True(longCaseUnionItems.Length > 0, "Expected a UnionCase classification covering 'IsHyperbolicCaseWithLongName'") From f807047ae7880ed84daca4802bdb474e7ec73ca7 Mon Sep 17 00:00:00 2001 From: Tomas Grosup Date: Tue, 17 Feb 2026 15:19:23 +0100 Subject: [PATCH 3/6] add release notes for PR #19311 --- docs/release-notes/.FSharp.Compiler.Service/10.0.300.md | 1 + 1 file changed, 1 insertion(+) diff --git a/docs/release-notes/.FSharp.Compiler.Service/10.0.300.md b/docs/release-notes/.FSharp.Compiler.Service/10.0.300.md index 6a30bf55364..b5fcb2911d6 100644 --- a/docs/release-notes/.FSharp.Compiler.Service/10.0.300.md +++ b/docs/release-notes/.FSharp.Compiler.Service/10.0.300.md @@ -10,6 +10,7 @@ * Fixed Find All References on discriminated union cases not including case tester properties (e.g., `.IsCase`). ([Issue #16621](https://github.com/dotnet/fsharp/issues/16621), [PR #19252](https://github.com/dotnet/fsharp/pull/19252)) * Fixed Find All References on record types not including copy-and-update expressions. ([Issue #15290](https://github.com/dotnet/fsharp/issues/15290), [PR #19252](https://github.com/dotnet/fsharp/pull/19252)) * Fixed Find All References on constructor definitions not finding all constructor usages. ([Issue #14902](https://github.com/dotnet/fsharp/issues/14902), [PR #19252](https://github.com/dotnet/fsharp/pull/19252)) +* Fixed semantic classification regression where copy-and-update record fields were colored as type names, and union case tester dot was colored as union case. ([PR #19311](https://github.com/dotnet/fsharp/pull/19311)) * Fix false FS1182 (unused variable) warning for query expression variables used in where, let, join, and select clauses. ([Issue #422](https://github.com/dotnet/fsharp/issues/422)) * Fix FS0229 B-stream misalignment when reading metadata from assemblies compiled with LangVersion < 9.0, introduced by [#17706](https://github.com/dotnet/fsharp/pull/17706). ([PR #19260](https://github.com/dotnet/fsharp/pull/19260)) * Fix FS3356 false positive for instance extension members with same name on different types, introduced by [#18821](https://github.com/dotnet/fsharp/pull/18821). ([PR #19260](https://github.com/dotnet/fsharp/pull/19260)) From eeacbd0c4d5aa0af648ae62c91d1126e101f0373 Mon Sep 17 00:00:00 2001 From: Tomas Grosup Date: Wed, 18 Feb 2026 15:34:45 +0100 Subject: [PATCH 4/6] drop range arithmetics --- src/Compiler/Checking/NameResolution.fs | 32 +++++++++++------------- src/Compiler/Checking/NameResolution.fsi | 4 +-- 2 files changed, 16 insertions(+), 20 deletions(-) diff --git a/src/Compiler/Checking/NameResolution.fs b/src/Compiler/Checking/NameResolution.fs index 6df34370038..add5a318b9d 100644 --- a/src/Compiler/Checking/NameResolution.fs +++ b/src/Compiler/Checking/NameResolution.fs @@ -2241,13 +2241,10 @@ let CallEnvSink (sink: TcResultsSink) (scopem, nenv, ad) = | None -> () | Some sink -> sink.NotifyEnvWithScope(scopem, nenv, ad) -// (#16621) Register union case tester properties as references to their underlying union case. -// For union case testers (e.g., IsB property), this ensures "Find All References" on a union case -// includes usages of its tester property. Uses the identifier range computed from the end of the -// member access range to avoid coloring the dot in "x.IsA" as a union case. +// #16621 let RegisterUnionCaseTesterForProperty (sink: TcResultsSink) - (m: range) + (identRange: range) (nenv: NameResolutionEnv) (pinfos: PropInfo list) (occurrenceType: ItemOccurrence) @@ -2266,11 +2263,6 @@ let RegisterUnionCaseTesterForProperty let ucref = tcref.MakeNestedUnionCaseRef ucase let ucinfo = UnionCaseInfo([], ucref) let ucItem = Item.UnionCase(ucinfo, false) - // Compute the range of just the property identifier (e.g., "IsA") from the end of the - // member access range, so it excludes any dot or qualifier prefix (e.g., "x." in "x.IsA"). - let propertyNameLength = 2 + caseName.Length // "Is" + caseName - let identStart = Position.mkPos m.EndLine (m.EndColumn - propertyNameLength) - let identRange = Range.mkRange m.FileName identStart m.End currentSink.NotifyNameResolution(identRange.End, ucItem, emptyTyparInst, occurrenceType, nenv, ad, identRange, false) | None -> () | _ -> () @@ -2281,20 +2273,12 @@ let CallNameResolutionSink (sink: TcResultsSink) (m: range, nenv, item, tpinst, | None -> () | Some currentSink -> currentSink.NotifyNameResolution(m.End, item, tpinst, occurrenceType, nenv, ad, m, false) - // (#16621) For union case tester properties, also register the underlying union case - match item with - | Item.Property(_, pinfos, _) -> RegisterUnionCaseTesterForProperty sink m nenv pinfos occurrenceType ad - | _ -> () let CallMethodGroupNameResolutionSink (sink: TcResultsSink) (m: range, nenv, item, itemMethodGroup, tpinst, occurrenceType, ad) = match sink.CurrentSink with | None -> () | Some currentSink -> currentSink.NotifyMethodGroupNameResolution(m.End, item, itemMethodGroup, tpinst, occurrenceType, nenv, ad, m, false) - // (#16621) For union case tester properties, also register the underlying union case - match item with - | Item.Property(_, pinfos, _) -> RegisterUnionCaseTesterForProperty sink m nenv pinfos occurrenceType ad - | _ -> () let CallNameResolutionSinkReplacing (sink: TcResultsSink) (m: range, nenv, item, tpinst, occurrenceType, ad) = match sink.CurrentSink with @@ -4204,6 +4188,12 @@ let ResolveLongIdentAsExprAndComputeRange (sink: TcResultsSink) (ncenv: NameReso CallMethodGroupNameResolutionSink sink (itemRange, nenv, refinedItem, item, tpinst, occurrence, ad) + // #16621 + match refinedItem with + | Item.Property(_, pinfos, _) -> + RegisterUnionCaseTesterForProperty sink (rangeOfLid lid) nenv pinfos occurrence ad + | _ -> () + let callSinkWithSpecificOverload (minfo: MethInfo, pinfoOpt: PropInfo option, tpinst) = let refinedItem = match pinfoOpt with @@ -4273,6 +4263,12 @@ let ResolveExprDotLongIdentAndComputeRange (sink: TcResultsSink) (ncenv: NameRes let unrefinedItem = FilterMethodGroups ncenv itemRange unrefinedItem staticOnly CallMethodGroupNameResolutionSink sink (itemRange, nenv, refinedItem, unrefinedItem, tpinst, ItemOccurrence.Use, ad) + // #16621 + match refinedItem with + | Item.Property(_, pinfos, _) -> + RegisterUnionCaseTesterForProperty sink (rangeOfLid lid) nenv pinfos ItemOccurrence.Use ad + | _ -> () + let callSinkWithSpecificOverload (minfo: MethInfo, pinfoOpt: PropInfo option, tpinst) = let refinedItem = match pinfoOpt with diff --git a/src/Compiler/Checking/NameResolution.fsi b/src/Compiler/Checking/NameResolution.fsi index dc42c830909..e9d70764bab 100755 --- a/src/Compiler/Checking/NameResolution.fsi +++ b/src/Compiler/Checking/NameResolution.fsi @@ -628,9 +628,9 @@ val internal CallMethodGroupNameResolutionSink: val internal CallNameResolutionSinkReplacing: TcResultsSink -> range * NameResolutionEnv * Item * TyparInstantiation * ItemOccurrence * AccessorDomain -> unit -/// (#16621) Register union case tester properties as references to their underlying union case +/// #16621 val internal RegisterUnionCaseTesterForProperty: - TcResultsSink -> range -> NameResolutionEnv -> PropInfo list -> ItemOccurrence -> AccessorDomain -> unit + TcResultsSink -> identRange: range -> NameResolutionEnv -> PropInfo list -> ItemOccurrence -> AccessorDomain -> unit /// Report a specific name resolution at a source range val internal CallExprHasTypeSink: TcResultsSink -> range * NameResolutionEnv * TType * AccessorDomain -> unit From 3f1792864382e5497e327d47becfc37126f1cb7e Mon Sep 17 00:00:00 2001 From: Tomas Grosup Date: Wed, 18 Feb 2026 20:04:25 +0100 Subject: [PATCH 5/6] Apply suggestions from code review --- src/Compiler/Checking/NameResolution.fs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/Compiler/Checking/NameResolution.fs b/src/Compiler/Checking/NameResolution.fs index add5a318b9d..30f430298bb 100644 --- a/src/Compiler/Checking/NameResolution.fs +++ b/src/Compiler/Checking/NameResolution.fs @@ -4191,7 +4191,7 @@ let ResolveLongIdentAsExprAndComputeRange (sink: TcResultsSink) (ncenv: NameReso // #16621 match refinedItem with | Item.Property(_, pinfos, _) -> - RegisterUnionCaseTesterForProperty sink (rangeOfLid lid) nenv pinfos occurrence ad + RegisterUnionCaseTesterForProperty sink itemRange nenv pinfos occurrence ad | _ -> () let callSinkWithSpecificOverload (minfo: MethInfo, pinfoOpt: PropInfo option, tpinst) = @@ -4266,7 +4266,7 @@ let ResolveExprDotLongIdentAndComputeRange (sink: TcResultsSink) (ncenv: NameRes // #16621 match refinedItem with | Item.Property(_, pinfos, _) -> - RegisterUnionCaseTesterForProperty sink (rangeOfLid lid) nenv pinfos ItemOccurrence.Use ad + RegisterUnionCaseTesterForProperty sink itemRange nenv pinfos ItemOccurrence.Use ad | _ -> () let callSinkWithSpecificOverload (minfo: MethInfo, pinfoOpt: PropInfo option, tpinst) = From 87cd4a88292f991c563cbb26d6664bf722a9d4c1 Mon Sep 17 00:00:00 2001 From: Tomas Grosup Date: Thu, 19 Feb 2026 14:16:41 +0100 Subject: [PATCH 6/6] fix range logic for x.IsCaseA.ToString() chain + extended testing --- src/Compiler/Checking/NameResolution.fs | 8 +- .../FSharpChecker/FindReferences.fs | 63 ++++++++++-- .../SemanticClassificationRegressions.fs | 98 +++++++++++-------- 3 files changed, 117 insertions(+), 52 deletions(-) diff --git a/src/Compiler/Checking/NameResolution.fs b/src/Compiler/Checking/NameResolution.fs index 30f430298bb..9d34ae76221 100644 --- a/src/Compiler/Checking/NameResolution.fs +++ b/src/Compiler/Checking/NameResolution.fs @@ -2263,7 +2263,7 @@ let RegisterUnionCaseTesterForProperty let ucref = tcref.MakeNestedUnionCaseRef ucase let ucinfo = UnionCaseInfo([], ucref) let ucItem = Item.UnionCase(ucinfo, false) - currentSink.NotifyNameResolution(identRange.End, ucItem, emptyTyparInst, occurrenceType, nenv, ad, identRange, false) + currentSink.NotifyNameResolution(identRange.End, ucItem, emptyTyparInst, occurrenceType, nenv, ad, identRange, true) | None -> () | _ -> () @@ -4191,7 +4191,8 @@ let ResolveLongIdentAsExprAndComputeRange (sink: TcResultsSink) (ncenv: NameReso // #16621 match refinedItem with | Item.Property(_, pinfos, _) -> - RegisterUnionCaseTesterForProperty sink itemRange nenv pinfos occurrence ad + let propIdentRange = if rest.IsEmpty then (List.last lid).idRange else itemRange + RegisterUnionCaseTesterForProperty sink propIdentRange nenv pinfos occurrence ad | _ -> () let callSinkWithSpecificOverload (minfo: MethInfo, pinfoOpt: PropInfo option, tpinst) = @@ -4266,7 +4267,8 @@ let ResolveExprDotLongIdentAndComputeRange (sink: TcResultsSink) (ncenv: NameRes // #16621 match refinedItem with | Item.Property(_, pinfos, _) -> - RegisterUnionCaseTesterForProperty sink itemRange nenv pinfos ItemOccurrence.Use ad + let propIdentRange = if rest.IsEmpty then (List.last lid).idRange else itemRange + RegisterUnionCaseTesterForProperty sink propIdentRange nenv pinfos ItemOccurrence.Use ad | _ -> () let callSinkWithSpecificOverload (minfo: MethInfo, pinfoOpt: PropInfo option, tpinst) = diff --git a/tests/FSharp.Compiler.ComponentTests/FSharpChecker/FindReferences.fs b/tests/FSharp.Compiler.ComponentTests/FSharpChecker/FindReferences.fs index 4b22719c2eb..ab7eca78aba 100644 --- a/tests/FSharp.Compiler.ComponentTests/FSharpChecker/FindReferences.fs +++ b/tests/FSharp.Compiler.ComponentTests/FSharpChecker/FindReferences.fs @@ -959,25 +959,68 @@ let o2 = { o with I.X = 2 } module UnionCaseTesters = [] - let ``Find references of union case B includes IsB usage`` () = + let ``Find references of union case includes tester usage`` () = + let source = """ +type MyUnion = CaseA | CaseB of int + +let x = CaseA +let useA = x.IsCaseA +let useB = x.IsCaseB +""" + testFindAllRefsMin source "CaseA" 3 |> ignore // Definition, construction, IsCaseA + testFindAllRefsMin source "CaseB" 2 // Definition + IsCaseB + + [] + let ``Find references of union case includes chained tester usage`` () = let source = """ type X = A | B let c = A -let result = c.IsB +let result = c.IsB.ToString() """ - testFindAllRefsMin source "B" 2 // Definition + IsB usage - + testFindAllRefsMin source "B" 2 // Definition + IsB even when chained + [] - let ``Find references of union case A includes IsA usage`` () = + let ``Find references of generic union case includes tester usage`` () = let source = """ -type MyUnion = CaseA | CaseB of int +type Result<'T> = Ok of 'T | Error of string -let x = CaseA -let useA = x.IsCaseA -let useB = x.IsCaseB +let r: Result = Ok 42 +let isOk = r.IsOk +""" + testFindAllRefsMin source "Ok" 3 // Definition, construction, IsOk + + [] + let ``Find references includes tester on RequireQualifiedAccess union`` () = + let source = """ +[] +type Token = Ident of string | Keyword + +let t = Token.Keyword +let isIdent = t.IsIdent +""" + testFindAllRefsMin source "Ident" 2 // Definition + IsIdent + + [] + let ``Find references includes multiple testers on same line`` () = + let source = """ +type X = A | B + +let c = A +let result = c.IsA && c.IsB +""" + testFindAllRefsMin source "A" 3 |> ignore // Definition, construction, IsA + testFindAllRefsMin source "B" 2 // Definition + IsB + + [] + let ``Find references includes self-referential tester in member`` () = + let source = """ +type Shape = + | Circle + | Square + member this.IsRound = this.IsCircle """ - testFindAllRefsMin source "CaseA" 3 // Definition, construction, IsCaseA + testFindAllRefsMin source "Circle" 2 // Definition + this.IsCircle /// https://github.com/dotnet/fsharp/issues/14902 module AdditionalConstructors = diff --git a/tests/FSharp.Compiler.ComponentTests/FSharpChecker/SemanticClassificationRegressions.fs b/tests/FSharp.Compiler.ComponentTests/FSharpChecker/SemanticClassificationRegressions.fs index 7a137396718..71d5f8cf7c8 100644 --- a/tests/FSharp.Compiler.ComponentTests/FSharpChecker/SemanticClassificationRegressions.fs +++ b/tests/FSharp.Compiler.ComponentTests/FSharpChecker/SemanticClassificationRegressions.fs @@ -63,9 +63,36 @@ let updated = { x with ValidationErrors = [] } (typeItemsCoveringField |> Array.map (fun i -> i.Range, i.Type)) ) +/// (#16621) Helper: assert UnionCase classifications on expected lines. +/// Each entry is (line, expectedCount, maxRangeWidth). +/// maxRangeWidth guards against dot-coloring regressions (range including "x." prefix). +let expectUnionCaseClassifications source (expectations: (int * int * int) list) = + let items = getClassifications source + + for (line, expectedCount, maxWidth) in expectations do + let found = + items + |> Array.filter (fun item -> + item.Type = SemanticClassificationType.UnionCase + && item.Range.StartLine = line) + + Assert.True( + found.Length = expectedCount, + sprintf "Line %d: expected %d UnionCase classification(s), got %d. Items on that line: %A" line expectedCount found.Length + (items + |> Array.filter (fun i -> i.Range.StartLine = line) + |> Array.map (fun i -> i.Range.StartColumn, i.Range.EndColumn, i.Type)) + ) + + for item in found do + let width = item.Range.EndColumn - item.Range.StartColumn + + Assert.True( + width <= maxWidth, + sprintf "Line %d: UnionCase range is too wide (%d columns, max %d): %A" line width maxWidth item.Range + ) + /// (#16621 regression) Union case tester classification must not include the dot. -/// Before the fix, RegisterUnionCaseTesterForProperty shifted m.Start by +1, -/// producing range ".IsCircle" whose dot survived fixupSpan. [] let ``Union case tester classification range should not include dot`` () = let source = @@ -77,42 +104,35 @@ let s = Circle let r1 = s.IsCircle let r2 = s.IsHyperbolicCaseWithLongName """ + // line, count, maxWidth + expectUnionCaseClassifications source [ (6, 1, 8); (7, 1, 30) ] - let items = getClassifications source - - // Find UnionCase classification items on lines 6 and 7 - let unionCaseItems = - items - |> Array.filter (fun item -> - item.Type = SemanticClassificationType.UnionCase - && (item.Range.StartLine = 6 || item.Range.StartLine = 7)) - - // There should be union case classifications for the tester properties - Assert.True( - unionCaseItems.Length > 0, - "Expected UnionCase classification for case tester properties" - ) - - // For each union case item, the range must NOT extend before the "Is" prefix. - // "s.IsCircle" — dot is at some column, "IsCircle" starts 1 column later. - // The union case range must start at or after the "Is" column. - for item in unionCaseItems do - // The range should cover at most the property name (e.g., "IsCircle" length 8) - // It should NOT start at or before the dot position. - let rangeWidth = item.Range.EndColumn - item.Range.StartColumn - - if item.Range.StartLine = 6 then - // "let r1 = s.IsCircle" — "IsCircle" has length 8 - // The dot is at column 11 (0-based: "let r1 = s" is 10 chars, dot at 10) - // "IsCircle" starts at column 11 (after the dot) - Assert.True( - rangeWidth <= 8, - sprintf "UnionCase range for IsCircle is too wide (%d columns): %A" rangeWidth item.Range - ) +/// (#16621) Union case tester classification across scenarios: chaining, RequireQualifiedAccess, +/// multiple testers on one line, and self-referential members. +[] +let ``Union case tester classification across scenarios`` () = + let source = + """ +module Test - if item.Range.StartLine = 7 then - // "let r2 = s.IsHyperbolicCaseWithLongName" — property name length = 2 + 28 = 30 - Assert.True( - rangeWidth <= 30, - sprintf "UnionCase range for IsHyperbolicCaseWithLongName is too wide (%d columns): %A" rangeWidth item.Range - ) +type Shape = Circle | Square +let s = Circle +let chained = s.IsCircle.ToString() +let both = s.IsCircle && s.IsSquare + +[] +type Token = Ident of string | Keyword +let t = Token.Keyword +let rqa = t.IsIdent + +type Animal = + | Cat + | Dog + member this.IsFeline = this.IsCat +""" + // line, count, maxWidth + expectUnionCaseClassifications source + [ (6, 1, 8) // s.IsCircle.ToString() — chained + (7, 2, 8) // s.IsCircle && s.IsSquare — two on same line + (12, 1, 7) // t.IsIdent — RequireQualifiedAccess + (17, 1, 5) ] // this.IsCat — self-referential member