Bugfix :: Coloring for case testers and with

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))

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

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

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

tests/FSharp.Compiler.ComponentTests/FSharp.Compiler.ComponentTests.fsproj

@@ -471,6 +471,7 @@
     <Compile Include="FSharpChecker\TransparentCompiler.fs" />
     <Compile Include="FSharpChecker\SymbolUse.fs" />
     <Compile Include="FSharpChecker\FindReferences.fs" />
+    <Compile Include="FSharpChecker\SemanticClassificationRegressions.fs" />
     <Compile Include="Attributes\AttributeCtorSetPropAccess.fs" />
   </ItemGroup>
 

tests/FSharp.Compiler.ComponentTests/FSharpChecker/FindReferences.fs

@@ -959,25 +959,68 @@ let o2 = { o with I.X = 2 }
 module UnionCaseTesters =
 
     [<Fact>]
-    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
+
+    [<Fact>]
+    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
+
     [<Fact>]
-    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<int> = Ok 42
+let isOk = r.IsOk
+"""
+        testFindAllRefsMin source "Ok" 3  // Definition, construction, IsOk
+
+    [<Fact>]
+    let ``Find references includes tester on RequireQualifiedAccess union`` () =
+        let source = """
+[<RequireQualifiedAccess>]
+type Token = Ident of string | Keyword
+
+let t = Token.Keyword
+let isIdent = t.IsIdent
+"""
+        testFindAllRefsMin source "Ident" 2  // Definition + IsIdent
+
+    [<Fact>]
+    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
+
+    [<Fact>]
+    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 =

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.
+[<Fact>]
+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.
+[<Fact>]
+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.
+[<Fact>]
+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
+
+[<RequireQualifiedAccess>]
+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