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 334398bfa7..ca425fb63c 100644 --- a/docs/release-notes/.FSharp.Compiler.Service/10.0.300.md +++ b/docs/release-notes/.FSharp.Compiler.Service/10.0.300.md @@ -15,6 +15,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)) diff --git a/src/Compiler/Checking/Expressions/CheckExpressions.fs b/src/Compiler/Checking/Expressions/CheckExpressions.fs index f0f36a3a0b..be76ee77ac 100644 --- a/src/Compiler/Checking/Expressions/CheckExpressions.fs +++ b/src/Compiler/Checking/Expressions/CheckExpressions.fs @@ -7861,10 +7861,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 b89c6d91d1..9d34ae7622 100644 --- a/src/Compiler/Checking/NameResolution.fs +++ b/src/Compiler/Checking/NameResolution.fs @@ -2241,12 +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 a shifted range to avoid duplicate filtering in ItemKeyStore. +// #16621 let RegisterUnionCaseTesterForProperty (sink: TcResultsSink) - (m: range) + (identRange: range) (nenv: NameResolutionEnv) (pinfos: PropInfo list) (occurrenceType: ItemOccurrence) @@ -2265,10 +2263,7 @@ 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) + currentSink.NotifyNameResolution(identRange.End, ucItem, emptyTyparInst, occurrenceType, nenv, ad, identRange, true) | None -> () | _ -> () @@ -2278,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 @@ -4201,6 +4188,13 @@ let ResolveLongIdentAsExprAndComputeRange (sink: TcResultsSink) (ncenv: NameReso CallMethodGroupNameResolutionSink sink (itemRange, nenv, refinedItem, item, tpinst, occurrence, ad) + // #16621 + match refinedItem with + | Item.Property(_, pinfos, _) -> + 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) = let refinedItem = match pinfoOpt with @@ -4270,6 +4264,13 @@ 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, _) -> + 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) = let refinedItem = match pinfoOpt with diff --git a/src/Compiler/Checking/NameResolution.fsi b/src/Compiler/Checking/NameResolution.fsi index dc42c83090..e9d70764ba 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 diff --git a/tests/FSharp.Compiler.ComponentTests/FSharp.Compiler.ComponentTests.fsproj b/tests/FSharp.Compiler.ComponentTests/FSharp.Compiler.ComponentTests.fsproj index 718f7239af..fd02dace6e 100644 --- a/tests/FSharp.Compiler.ComponentTests/FSharp.Compiler.ComponentTests.fsproj +++ b/tests/FSharp.Compiler.ComponentTests/FSharp.Compiler.ComponentTests.fsproj @@ -471,6 +471,7 @@ + diff --git a/tests/FSharp.Compiler.ComponentTests/FSharpChecker/FindReferences.fs b/tests/FSharp.Compiler.ComponentTests/FSharpChecker/FindReferences.fs index 4b22719c2e..ab7eca78ab 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 new file mode 100644 index 0000000000..71d5f8cf7c --- /dev/null +++ b/tests/FSharp.Compiler.ComponentTests/FSharpChecker/SemanticClassificationRegressions.fs @@ -0,0 +1,138 @@ +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) 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. +[] +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 +""" + // line, count, maxWidth + expectUnionCaseClassifications source [ (6, 1, 8); (7, 1, 30) ] + +/// (#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 + +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 diff --git a/vsintegration/tests/FSharp.Editor.Tests/SemanticClassificationServiceTests.fs b/vsintegration/tests/FSharp.Editor.Tests/SemanticClassificationServiceTests.fs index b80956ddbc..7338e794c8 100644 --- a/vsintegration/tests/FSharp.Editor.Tests/SemanticClassificationServiceTests.fs +++ b/vsintegration/tests/FSharp.Editor.Tests/SemanticClassificationServiceTests.fs @@ -306,3 +306,112 @@ 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 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'")