Skip to content

Commit 7d0437e

Browse files
T-GroT-Gro
authored
Bugfix :: Coloring for case testers and with (#19311)
1 parent d7198ae commit 7d0437e

File tree

8 files changed

+326
-30
lines changed

8 files changed

+326
-30
lines changed

‎docs/release-notes/.FSharp.Compiler.Service/10.0.300.md‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -15,6 +15,7 @@
1515
* 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))
1616
* 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))
1717
* 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))
18+
* 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))
1819
* 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))
1920
* 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))
2021
* 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‎

Lines changed: 5 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -7861,10 +7861,13 @@ and TcRecdExpr cenv overallTy env tpenv (inherits, withExprOpt, synRecdFields, m
78617861
UnifyTypes cenv env mWholeExpr overallTy gtyp
78627862

78637863
// (#15290) For copy-and-update expressions, register the record type as a reference
7864-
// so that "Find All References" on the record type includes copy-and-update usages
7864+
// so that "Find All References" on the record type includes copy-and-update usages.
7865+
// Use a zero-width range at the start of the expression to avoid affecting semantic
7866+
// classification (coloring) of field names and other tokens within the expression.
78657867
if hasOrigExpr then
78667868
let item = Item.Types(tcref.DisplayName, [gtyp])
7867-
CallNameResolutionSink cenv.tcSink (mWholeExpr, env.NameEnv, item, emptyTyparInst, ItemOccurrence.Use, env.eAccessRights)
7869+
let pointRange = Range.mkRange mWholeExpr.FileName mWholeExpr.Start mWholeExpr.Start
7870+
CallNameResolutionSink cenv.tcSink (pointRange, env.NameEnv, item, emptyTyparInst, ItemOccurrence.Use, env.eAccessRights)
78687871

78697872
[ for n, v in fldsList do
78707873
match v with

‎src/Compiler/Checking/NameResolution.fs‎

Lines changed: 17 additions & 16 deletions
Original file line numberDiff line numberDiff line change
@@ -2241,12 +2241,10 @@ let CallEnvSink (sink: TcResultsSink) (scopem, nenv, ad) =
22412241
| None -> ()
22422242
| Some sink -> sink.NotifyEnvWithScope(scopem, nenv, ad)
22432243

2244-
// (#16621) Register union case tester properties as references to their underlying union case.
2245-
// For union case testers (e.g., IsB property), this ensures "Find All References" on a union case
2246-
// includes usages of its tester property. Uses a shifted range to avoid duplicate filtering in ItemKeyStore.
2244+
// #16621
22472245
let RegisterUnionCaseTesterForProperty
22482246
(sink: TcResultsSink)
2249-
(m: range)
2247+
(identRange: range)
22502248
(nenv: NameResolutionEnv)
22512249
(pinfos: PropInfo list)
22522250
(occurrenceType: ItemOccurrence)
@@ -2265,10 +2263,7 @@ let RegisterUnionCaseTesterForProperty
22652263
let ucref = tcref.MakeNestedUnionCaseRef ucase
22662264
let ucinfo = UnionCaseInfo([], ucref)
22672265
let ucItem = Item.UnionCase(ucinfo, false)
2268-
// Shift start by 1 column to distinguish from the property reference
2269-
let shiftedStart = Position.mkPos m.StartLine (m.StartColumn + 1)
2270-
let shiftedRange = Range.withStart shiftedStart m
2271-
currentSink.NotifyNameResolution(shiftedRange.End, ucItem, emptyTyparInst, occurrenceType, nenv, ad, shiftedRange, false)
2266+
currentSink.NotifyNameResolution(identRange.End, ucItem, emptyTyparInst, occurrenceType, nenv, ad, identRange, true)
22722267
| None -> ()
22732268
| _ -> ()
22742269

@@ -2278,20 +2273,12 @@ let CallNameResolutionSink (sink: TcResultsSink) (m: range, nenv, item, tpinst,
22782273
| None -> ()
22792274
| Some currentSink ->
22802275
currentSink.NotifyNameResolution(m.End, item, tpinst, occurrenceType, nenv, ad, m, false)
2281-
// (#16621) For union case tester properties, also register the underlying union case
2282-
match item with
2283-
| Item.Property(_, pinfos, _) -> RegisterUnionCaseTesterForProperty sink m nenv pinfos occurrenceType ad
2284-
| _ -> ()
22852276

22862277
let CallMethodGroupNameResolutionSink (sink: TcResultsSink) (m: range, nenv, item, itemMethodGroup, tpinst, occurrenceType, ad) =
22872278
match sink.CurrentSink with
22882279
| None -> ()
22892280
| Some currentSink ->
22902281
currentSink.NotifyMethodGroupNameResolution(m.End, item, itemMethodGroup, tpinst, occurrenceType, nenv, ad, m, false)
2291-
// (#16621) For union case tester properties, also register the underlying union case
2292-
match item with
2293-
| Item.Property(_, pinfos, _) -> RegisterUnionCaseTesterForProperty sink m nenv pinfos occurrenceType ad
2294-
| _ -> ()
22952282

22962283
let CallNameResolutionSinkReplacing (sink: TcResultsSink) (m: range, nenv, item, tpinst, occurrenceType, ad) =
22972284
match sink.CurrentSink with
@@ -4201,6 +4188,13 @@ let ResolveLongIdentAsExprAndComputeRange (sink: TcResultsSink) (ncenv: NameReso
42014188

42024189
CallMethodGroupNameResolutionSink sink (itemRange, nenv, refinedItem, item, tpinst, occurrence, ad)
42034190

4191+
// #16621
4192+
match refinedItem with
4193+
| Item.Property(_, pinfos, _) ->
4194+
let propIdentRange = if rest.IsEmpty then (List.last lid).idRange else itemRange
4195+
RegisterUnionCaseTesterForProperty sink propIdentRange nenv pinfos occurrence ad
4196+
| _ -> ()
4197+
42044198
let callSinkWithSpecificOverload (minfo: MethInfo, pinfoOpt: PropInfo option, tpinst) =
42054199
let refinedItem =
42064200
match pinfoOpt with
@@ -4270,6 +4264,13 @@ let ResolveExprDotLongIdentAndComputeRange (sink: TcResultsSink) (ncenv: NameRes
42704264
let unrefinedItem = FilterMethodGroups ncenv itemRange unrefinedItem staticOnly
42714265
CallMethodGroupNameResolutionSink sink (itemRange, nenv, refinedItem, unrefinedItem, tpinst, ItemOccurrence.Use, ad)
42724266

4267+
// #16621
4268+
match refinedItem with
4269+
| Item.Property(_, pinfos, _) ->
4270+
let propIdentRange = if rest.IsEmpty then (List.last lid).idRange else itemRange
4271+
RegisterUnionCaseTesterForProperty sink propIdentRange nenv pinfos ItemOccurrence.Use ad
4272+
| _ -> ()
4273+
42734274
let callSinkWithSpecificOverload (minfo: MethInfo, pinfoOpt: PropInfo option, tpinst) =
42744275
let refinedItem =
42754276
match pinfoOpt with

‎src/Compiler/Checking/NameResolution.fsi‎

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -628,9 +628,9 @@ val internal CallMethodGroupNameResolutionSink:
628628
val internal CallNameResolutionSinkReplacing:
629629
TcResultsSink -> range * NameResolutionEnv * Item * TyparInstantiation * ItemOccurrence * AccessorDomain -> unit
630630

631-
/// (#16621) Register union case tester properties as references to their underlying union case
631+
/// #16621
632632
val internal RegisterUnionCaseTesterForProperty:
633-
TcResultsSink -> range -> NameResolutionEnv -> PropInfo list -> ItemOccurrence -> AccessorDomain -> unit
633+
TcResultsSink -> identRange: range -> NameResolutionEnv -> PropInfo list -> ItemOccurrence -> AccessorDomain -> unit
634634

635635
/// Report a specific name resolution at a source range
636636
val internal CallExprHasTypeSink: TcResultsSink -> range * NameResolutionEnv * TType * AccessorDomain -> unit

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

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -471,6 +471,7 @@
471471
<Compile Include="FSharpChecker\TransparentCompiler.fs" />
472472
<Compile Include="FSharpChecker\SymbolUse.fs" />
473473
<Compile Include="FSharpChecker\FindReferences.fs" />
474+
<Compile Include="FSharpChecker\SemanticClassificationRegressions.fs" />
474475
<Compile Include="Attributes\AttributeCtorSetPropAccess.fs" />
475476
</ItemGroup>
476477

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

Lines changed: 53 additions & 10 deletions
Original file line numberDiff line numberDiff line change
@@ -959,25 +959,68 @@ let o2 = { o with I.X = 2 }
959959
module UnionCaseTesters =
960960

961961
[<Fact>]
962-
let ``Find references of union case B includes IsB usage`` () =
962+
let ``Find references of union case includes tester usage`` () =
963+
let source = """
964+
type MyUnion = CaseA | CaseB of int
965+
966+
let x = CaseA
967+
let useA = x.IsCaseA
968+
let useB = x.IsCaseB
969+
"""
970+
testFindAllRefsMin source "CaseA" 3 |> ignore // Definition, construction, IsCaseA
971+
testFindAllRefsMin source "CaseB" 2 // Definition + IsCaseB
972+
973+
[<Fact>]
974+
let ``Find references of union case includes chained tester usage`` () =
963975
let source = """
964976
type X = A | B
965977
966978
let c = A
967-
let result = c.IsB
979+
let result = c.IsB.ToString()
968980
"""
969-
testFindAllRefsMin source "B" 2 // Definition + IsB usage
970-
981+
testFindAllRefsMin source "B" 2 // Definition + IsB even when chained
982+
971983
[<Fact>]
972-
let ``Find references of union case A includes IsA usage`` () =
984+
let ``Find references of generic union case includes tester usage`` () =
973985
let source = """
974-
type MyUnion = CaseA | CaseB of int
986+
type Result<'T> = Ok of 'T | Error of string
975987
976-
let x = CaseA
977-
let useA = x.IsCaseA
978-
let useB = x.IsCaseB
988+
let r: Result<int> = Ok 42
989+
let isOk = r.IsOk
990+
"""
991+
testFindAllRefsMin source "Ok" 3 // Definition, construction, IsOk
992+
993+
[<Fact>]
994+
let ``Find references includes tester on RequireQualifiedAccess union`` () =
995+
let source = """
996+
[<RequireQualifiedAccess>]
997+
type Token = Ident of string | Keyword
998+
999+
let t = Token.Keyword
1000+
let isIdent = t.IsIdent
1001+
"""
1002+
testFindAllRefsMin source "Ident" 2 // Definition + IsIdent
1003+
1004+
[<Fact>]
1005+
let ``Find references includes multiple testers on same line`` () =
1006+
let source = """
1007+
type X = A | B
1008+
1009+
let c = A
1010+
let result = c.IsA && c.IsB
1011+
"""
1012+
testFindAllRefsMin source "A" 3 |> ignore // Definition, construction, IsA
1013+
testFindAllRefsMin source "B" 2 // Definition + IsB
1014+
1015+
[<Fact>]
1016+
let ``Find references includes self-referential tester in member`` () =
1017+
let source = """
1018+
type Shape =
1019+
| Circle
1020+
| Square
1021+
member this.IsRound = this.IsCircle
9791022
"""
980-
testFindAllRefsMin source "CaseA" 3 // Definition, construction, IsCaseA
1023+
testFindAllRefsMin source "Circle" 2 // Definition + this.IsCircle
9811024

9821025
/// https://github.com/dotnet/fsharp/issues/14902
9831026
module AdditionalConstructors =

‎tests/FSharp.Compiler.ComponentTests/FSharpChecker/SemanticClassificationRegressions.fs‎

Lines changed: 138 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,138 @@
1+
module FSharpChecker.SemanticClassificationRegressions
2+
3+
open Xunit
4+
open FSharp.Compiler.CodeAnalysis
5+
open FSharp.Compiler.EditorServices
6+
open FSharp.Compiler.Text
7+
open FSharp.Test.ProjectGeneration
8+
open FSharp.Test.ProjectGeneration.Helpers
9+
10+
#nowarn "57"
11+
12+
/// Get semantic classification items for a single-file source using the transparent compiler.
13+
let getClassifications (source: string) =
14+
let fileName, snapshot, checker = singleFileChecker source
15+
let results = checker.ParseAndCheckFileInProject(fileName, snapshot) |> Async.RunSynchronously
16+
let checkResults = getTypeCheckResult results
17+
checkResults.GetSemanticClassification(None)
18+
19+
/// (#15290 regression) Copy-and-update record fields must not be classified as type names.
20+
/// Before the fix, Item.Types was registered with mWholeExpr and ItemOccurrence.Use, producing
21+
/// a wide type classification that overshadowed the correct RecordField classification.
22+
[<Fact>]
23+
let ``Copy-and-update field should not be classified as type name`` () =
24+
let source =
25+
"""
26+
module Test
27+
28+
type MyRecord = { ValidationErrors: string list; Name: string }
29+
let x: MyRecord = { ValidationErrors = []; Name = "" }
30+
let updated = { x with ValidationErrors = [] }
31+
"""
32+
33+
let items = getClassifications source
34+
35+
// Line 6 contains "{ x with ValidationErrors = [] }"
36+
// "ValidationErrors" starts around column 23 (after "let updated = { x with ")
37+
// It should be RecordField, NOT ReferenceType/ValueType.
38+
let fieldLine = 6
39+
40+
let fieldItems =
41+
items
42+
|> Array.filter (fun item ->
43+
item.Range.StartLine = fieldLine
44+
&& item.Type = SemanticClassificationType.RecordField)
45+
46+
Assert.True(fieldItems.Length > 0, "Expected RecordField classification on the copy-and-update line")
47+
48+
// No type classification should cover the field name on that line with a visible range
49+
let typeItemsCoveringField =
50+
items
51+
|> Array.filter (fun item ->
52+
item.Range.StartLine <= fieldLine
53+
&& item.Range.EndLine >= fieldLine
54+
&& item.Range.Start <> item.Range.End
55+
&& (item.Type = SemanticClassificationType.ReferenceType
56+
|| item.Type = SemanticClassificationType.ValueType
57+
|| item.Type = SemanticClassificationType.Type))
58+
59+
Assert.True(
60+
typeItemsCoveringField.Length = 0,
61+
sprintf
62+
"No type classification should cover the copy-and-update line, but found: %A"
63+
(typeItemsCoveringField |> Array.map (fun i -> i.Range, i.Type))
64+
)
65+
66+
/// (#16621) Helper: assert UnionCase classifications on expected lines.
67+
/// Each entry is (line, expectedCount, maxRangeWidth).
68+
/// maxRangeWidth guards against dot-coloring regressions (range including "x." prefix).
69+
let expectUnionCaseClassifications source (expectations: (int * int * int) list) =
70+
let items = getClassifications source
71+
72+
for (line, expectedCount, maxWidth) in expectations do
73+
let found =
74+
items
75+
|> Array.filter (fun item ->
76+
item.Type = SemanticClassificationType.UnionCase
77+
&& item.Range.StartLine = line)
78+
79+
Assert.True(
80+
found.Length = expectedCount,
81+
sprintf "Line %d: expected %d UnionCase classification(s), got %d. Items on that line: %A" line expectedCount found.Length
82+
(items
83+
|> Array.filter (fun i -> i.Range.StartLine = line)
84+
|> Array.map (fun i -> i.Range.StartColumn, i.Range.EndColumn, i.Type))
85+
)
86+
87+
for item in found do
88+
let width = item.Range.EndColumn - item.Range.StartColumn
89+
90+
Assert.True(
91+
width <= maxWidth,
92+
sprintf "Line %d: UnionCase range is too wide (%d columns, max %d): %A" line width maxWidth item.Range
93+
)
94+
95+
/// (#16621 regression) Union case tester classification must not include the dot.
96+
[<Fact>]
97+
let ``Union case tester classification range should not include dot`` () =
98+
let source =
99+
"""
100+
module Test
101+
102+
type Shape = Circle | Square | HyperbolicCaseWithLongName
103+
let s = Circle
104+
let r1 = s.IsCircle
105+
let r2 = s.IsHyperbolicCaseWithLongName
106+
"""
107+
// line, count, maxWidth
108+
expectUnionCaseClassifications source [ (6, 1, 8); (7, 1, 30) ]
109+
110+
/// (#16621) Union case tester classification across scenarios: chaining, RequireQualifiedAccess,
111+
/// multiple testers on one line, and self-referential members.
112+
[<Fact>]
113+
let ``Union case tester classification across scenarios`` () =
114+
let source =
115+
"""
116+
module Test
117+
118+
type Shape = Circle | Square
119+
let s = Circle
120+
let chained = s.IsCircle.ToString()
121+
let both = s.IsCircle && s.IsSquare
122+
123+
[<RequireQualifiedAccess>]
124+
type Token = Ident of string | Keyword
125+
let t = Token.Keyword
126+
let rqa = t.IsIdent
127+
128+
type Animal =
129+
| Cat
130+
| Dog
131+
member this.IsFeline = this.IsCat
132+
"""
133+
// line, count, maxWidth
134+
expectUnionCaseClassifications source
135+
[ (6, 1, 8) // s.IsCircle.ToString() — chained
136+
(7, 2, 8) // s.IsCircle && s.IsSquare — two on same line
137+
(12, 1, 7) // t.IsIdent — RequireQualifiedAccess
138+
(17, 1, 5) ] // this.IsCat — self-referential member

0 commit comments

Comments
 (0)