Skip to content

Commit 56491f1

Browse files
T-GroCopilot
andcommitted
Fix DU duplicate methods, event metadata
Fixes #14321 Fixes #16565 Fixes #5834 Co-authored-by: Copilot <223556219+Copilot@users.noreply.github.com>
1 parent 7d0437e commit 56491f1

5 files changed

Lines changed: 227 additions & 3 deletions

File tree

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

Lines changed: 3 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -21,6 +21,9 @@
2121
* 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))
2222
* Fix graph-based type checking incorrectly resolving dependencies when the same module name is defined across multiple files in the same namespace. ([PR #19280](https://github.com/dotnet/fsharp/pull/19280))
2323
* F# Scripts: Fix default reference paths resolving when an SDK directory is specified. ([PR #19270](https://github.com/dotnet/fsharp/pull/19270))
24+
* Fix DU case names matching IWSAM member names no longer cause duplicate property entries. (Issue [#14321](https://github.com/dotnet/fsharp/issues/14321), [PR #19341](https://github.com/dotnet/fsharp/pull/19341))
25+
* Fix DefaultAugmentation(false) duplicate entry in method table. (Issue [#16565](https://github.com/dotnet/fsharp/issues/16565), [PR #19341](https://github.com/dotnet/fsharp/pull/19341))
26+
* Fix abstract event accessors now have SpecialName flag. (Issue [#5834](https://github.com/dotnet/fsharp/issues/5834), [PR #19341](https://github.com/dotnet/fsharp/pull/19341))
2427

2528
### Added
2629
* FSharpType: add ImportILType ([PR #19300](https://github.com/dotnet/fsharp/pull/19300))

src/Compiler/Checking/Expressions/CheckExpressions.fs

Lines changed: 5 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -13077,7 +13077,11 @@ let TcAndPublishValSpec (cenv: cenv, env, containerInfo: ContainerInfo, declKind
1307713077

1307813078
let checkXmlDocs = cenv.diagnosticOptions.CheckXmlDocs
1307913079
let xmlDoc = xmlDoc.ToXmlDoc(checkXmlDocs, paramNames)
13080-
let vspec = MakeAndPublishVal cenv env (altActualParent, true, declKind, ValNotInRecScope, valscheme, attrs, xmlDoc, literalValue, false)
13080+
let isGeneratedEventVal =
13081+
CompileAsEvent g attrs
13082+
&& (id.idText.StartsWithOrdinal("add_") || id.idText.StartsWithOrdinal("remove_"))
13083+
13084+
let vspec = MakeAndPublishVal cenv env (altActualParent, true, declKind, ValNotInRecScope, valscheme, attrs, xmlDoc, literalValue, isGeneratedEventVal)
1308113085

1308213086
PublishArguments cenv env vspec synValSig allDeclaredTypars.Length
1308313087

src/Compiler/CodeGen/IlxGen.fs

Lines changed: 26 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -10750,6 +10750,13 @@ and GenAbstractBinding cenv eenv tref (vref: ValRef) =
1075010750
| SynMemberKind.Constructor
1075110751
| SynMemberKind.Member ->
1075210752
let mdef = mdef.With(customAttrs = mkILCustomAttrs ilAttrs)
10753+
10754+
let mdef =
10755+
if vref.Deref.val_flags.IsGeneratedEventVal then
10756+
mdef.WithSpecialName
10757+
else
10758+
mdef
10759+
1075310760
[ mdef ], [], []
1075410761
| SynMemberKind.PropertyGetSet -> error (Error(FSComp.SR.ilUnexpectedGetSetAnnotation (), m))
1075510762
| SynMemberKind.PropertySet
@@ -11768,6 +11775,17 @@ and GenTypeDef cenv mgbuf lazyInitInfo eenv m (tycon: Tycon) : ILTypeRef option
1176811775
//
1176911776
// Also discard the F#-compiler supplied implementation of the Empty, IsEmpty, Value and None properties.
1177011777

11778+
let nullaryCaseNames =
11779+
if cuinfo.HasHelpers = AllHelpers || cuinfo.HasHelpers = NoHelpers then
11780+
cuinfo.UnionCases
11781+
|> Array.choose (fun alt -> if alt.IsNullary then Some alt.Name else None)
11782+
|> Set.ofArray
11783+
else
11784+
Set.empty
11785+
11786+
let isNullaryCaseClash name =
11787+
not nullaryCaseNames.IsEmpty && nullaryCaseNames.Contains name
11788+
1177111789
let tdefDiscards =
1177211790
Some(
1177311791
(fun (md: ILMethodDef) ->
@@ -11776,15 +11794,21 @@ and GenTypeDef cenv mgbuf lazyInitInfo eenv m (tycon: Tycon) : ILTypeRef option
1177611794
|| (cuinfo.HasHelpers = SpecialFSharpOptionHelpers
1177711795
&& (md.Name = "get_Value" || md.Name = "get_None" || md.Name = "Some"))
1177811796
|| (cuinfo.HasHelpers = AllHelpers
11779-
&& (md.Name.StartsWith("get_Is") && not (tdef2.Methods.FindByName(md.Name).IsEmpty)))),
11797+
&& (md.Name.StartsWith("get_Is") && not (tdef2.Methods.FindByName(md.Name).IsEmpty)))
11798+
|| (md.Name.StartsWith("get_")
11799+
&& md.Name.Length > 4
11800+
&& isNullaryCaseClash (md.Name.Substring(4))
11801+
&& not (tdef2.Methods.FindByName(md.Name).IsEmpty))),
1178011802

1178111803
(fun (pd: ILPropertyDef) ->
1178211804
(cuinfo.HasHelpers = SpecialFSharpListHelpers
1178311805
&& (pd.Name = "Empty" || pd.Name = "IsEmpty"))
1178411806
|| (cuinfo.HasHelpers = SpecialFSharpOptionHelpers
1178511807
&& (pd.Name = "Value" || pd.Name = "None"))
1178611808
|| (cuinfo.HasHelpers = AllHelpers
11787-
&& (pd.Name.StartsWith("Is") && not (tdef2.Properties.LookupByName(pd.Name).IsEmpty))))
11809+
&& (pd.Name.StartsWith("Is") && not (tdef2.Properties.LookupByName(pd.Name).IsEmpty)))
11810+
|| (isNullaryCaseClash pd.Name
11811+
&& not (tdef2.Properties.LookupByName(pd.Name).IsEmpty)))
1178811812
)
1178911813

1179011814
tdef2, tdefDiscards
Lines changed: 192 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,192 @@
1+
// Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information.
2+
3+
namespace EmittedIL
4+
5+
open Xunit
6+
open FSharp.Test
7+
open FSharp.Test.Compiler
8+
open FSharp.Test.Utilities
9+
10+
module CodeGenRegressions_TypeDefs =
11+
12+
let private getActualIL (result: CompilationResult) =
13+
match result with
14+
| CompilationResult.Success s ->
15+
match s.OutputPath with
16+
| Some p ->
17+
let (_, _, actualIL) = ILChecker.verifyILAndReturnActual [] p [ "// dummy" ]
18+
actualIL
19+
| None -> failwith "No output path"
20+
| _ -> failwith "Compilation failed"
21+
22+
// https://github.com/dotnet/fsharp/issues/16565
23+
[<Fact>]
24+
let ``Issue_16565_DefaultAugmentationFalseDuplicateEntry`` () =
25+
let source = """
26+
module Test
27+
28+
open System
29+
30+
[<DefaultAugmentation(false)>]
31+
type Option<'T> =
32+
| Some of Value: 'T
33+
| None
34+
35+
member x.Value =
36+
match x with
37+
| Some x -> x
38+
| None -> raise (new InvalidOperationException("Option.Value"))
39+
40+
static member None : Option<'T> = None
41+
42+
and 'T option = Option<'T>
43+
44+
let v = Option.Some 42
45+
printfn "Value: %d" v.Value
46+
let n = Option<int>.None
47+
printfn "None created successfully"
48+
"""
49+
FSharp source
50+
|> asExe
51+
|> compile
52+
|> shouldSucceed
53+
|> run
54+
|> shouldSucceed
55+
|> ignore
56+
57+
// https://github.com/dotnet/fsharp/issues/14321
58+
[<Fact>]
59+
let ``Issue_14321_DuAndIWSAMNames`` () =
60+
let source = """
61+
module Test
62+
63+
#nowarn "3535" // IWSAM warning
64+
65+
type EngineError<'e> =
66+
static abstract Overheated : 'e
67+
static abstract LowOil : 'e
68+
69+
type CarError =
70+
| Overheated
71+
| LowOil
72+
| DeviceNotPaired
73+
74+
interface EngineError<CarError> with
75+
static member Overheated = Overheated
76+
static member LowOil = LowOil
77+
"""
78+
FSharp source
79+
|> asLibrary
80+
|> compile
81+
|> shouldSucceed
82+
|> ignore
83+
84+
// https://github.com/dotnet/fsharp/issues/14321
85+
// Runtime test: type must load without "duplicate entry in method table"
86+
[<Fact>]
87+
let ``Issue_14321_DuAndIWSAMNames_Runtime`` () =
88+
let source = """
89+
module Test
90+
91+
#nowarn "3535"
92+
93+
type EngineError<'e> =
94+
static abstract Overheated : 'e
95+
static abstract LowOil : 'e
96+
97+
type CarError =
98+
| Overheated
99+
| LowOil
100+
| DeviceNotPaired
101+
102+
interface EngineError<CarError> with
103+
static member Overheated = Overheated
104+
static member LowOil = LowOil
105+
106+
[<EntryPoint>]
107+
let main _ =
108+
let err = CarError.Overheated
109+
match err with
110+
| Overheated -> printfn "Got Overheated"
111+
| LowOil -> printfn "Got LowOil"
112+
| DeviceNotPaired -> printfn "Got DeviceNotPaired"
113+
0
114+
"""
115+
FSharp source
116+
|> asExe
117+
|> compile
118+
|> shouldSucceed
119+
|> run
120+
|> shouldSucceed
121+
|> ignore
122+
123+
// https://github.com/dotnet/fsharp/issues/5834
124+
[<Fact>]
125+
let ``Issue_5834_EventSpecialname`` () =
126+
let source = """
127+
module Test
128+
129+
open System
130+
open System.Reflection
131+
132+
type IAbstract1 =
133+
[<CLIEvent>]
134+
abstract member Event : IEvent<EventHandler, EventArgs>
135+
136+
type IAbstract2 =
137+
[<CLIEvent>]
138+
abstract member Event : IDelegateEvent<EventHandler>
139+
140+
[<AbstractClass>]
141+
type Abstract3() =
142+
[<CLIEvent>]
143+
abstract member Event : IDelegateEvent<EventHandler>
144+
145+
type Concrete1() =
146+
let event = new Event<EventHandler, EventArgs>()
147+
[<CLIEvent>]
148+
member this.Event = event.Publish
149+
150+
type Concrete2() =
151+
[<CLIEvent>]
152+
member this.Event = { new IDelegateEvent<EventHandler> with
153+
member this.AddHandler _ = ()
154+
member this.RemoveHandler _ = () }
155+
156+
type ConcreteWithObsolete() =
157+
let evt = new Event<EventHandler, EventArgs>()
158+
[<Obsolete("deprecated")>]
159+
[<CLIEvent>]
160+
member this.MyEvent = evt.Publish
161+
162+
[<EntryPoint>]
163+
let main _ =
164+
let mutable failures = 0
165+
let check (t: Type) =
166+
t.GetMethods(BindingFlags.Public ||| BindingFlags.Instance ||| BindingFlags.DeclaredOnly)
167+
|> Array.filter (fun m -> m.Name.Contains("Event"))
168+
|> Array.iter (fun m ->
169+
if not m.IsSpecialName then
170+
printfn "FAIL: %s.%s missing specialname" t.Name m.Name
171+
failures <- failures + 1)
172+
173+
check typeof<IAbstract1>
174+
check typeof<IAbstract2>
175+
check typeof<Abstract3>
176+
check typeof<Concrete1>
177+
check typeof<Concrete2>
178+
check typeof<ConcreteWithObsolete>
179+
180+
if failures > 0 then
181+
failwithf "BUG: %d event accessors missing specialname" failures
182+
printfn "SUCCESS: All event accessors have specialname"
183+
0
184+
"""
185+
FSharp source
186+
|> asExe
187+
|> compile
188+
|> shouldSucceed
189+
|> run
190+
|> shouldSucceed
191+
|> ignore
192+

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

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -280,6 +280,7 @@
280280
<Compile Include="EmittedIL\Nullness\NullnessMetadata.fs" />
281281
<Compile Include="EmittedIL\FixedBindings\FixedBindings.fs" />
282282
<Compile Include="EmittedIL\CodeGenRegressions\CodeGenRegressions_Observations.fs" />
283+
<Compile Include="EmittedIL\CodeGenRegressions\CodeGenRegressions_TypeDefs.fs" />
283284
<Compile Include="ErrorMessages\TypedInterpolatedStringsTests.fs" />
284285
<!--<Compile Include="EmittedIL\StructDefensiveCopy\StructDefensiveCopy.fs" />-->
285286
<Compile Include="ErrorMessages\UnsupportedAttributes.fs" />

0 commit comments

Comments
 (0)