Thanks to visit codestin.com
Credit goes to github.com

Skip to content

Commit 503985c

Browse files
authored
Bugfix :: Fix type definition metadata: duplicate methods, event flags (#19341)
Co-authored-by: abonie <[email protected]>
1 parent a7aaade commit 503985c

5 files changed

Lines changed: 325 additions & 3 deletions

File tree

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

Lines changed: 3 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -1,5 +1,8 @@
11
### Fixed
22

3+
* 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))
4+
* 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))
5+
* 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))
36
* Fix CLIEvent properties to be correctly recognized as events: `IsEvent` returns `true` and `XmlDocSig` uses `E:` prefix instead of `P:`. ([Issue #10273](https://github.com/dotnet/fsharp/issues/10273), [PR #18584](https://github.com/dotnet/fsharp/pull/18584))
47
* Fix extra sequence point at the end of match expressions. ([Issue #12052](https://github.com/dotnet/fsharp/issues/12052), [PR #19278](https://github.com/dotnet/fsharp/pull/19278))
58
* Fix wrong sequence point range for `return`/`yield`/`return!`/`yield!` inside computation expressions. ([Issue #19248](https://github.com/dotnet/fsharp/issues/19248), [PR #19278](https://github.com/dotnet/fsharp/pull/19278))

src/Compiler/Checking/Expressions/CheckExpressions.fs

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

1314713147
let checkXmlDocs = cenv.diagnosticOptions.CheckXmlDocs
1314813148
let xmlDoc = xmlDoc.ToXmlDoc(checkXmlDocs, paramNames)
13149-
let vspec = MakeAndPublishVal cenv env (altActualParent, true, declKind, ValNotInRecScope, valscheme, attrs, xmlDoc, literalValue, false)
13149+
let isGeneratedEventVal =
13150+
CompileAsEvent g attrs
13151+
&& (id.idText.StartsWithOrdinal("add_") || id.idText.StartsWithOrdinal("remove_"))
13152+
13153+
let vspec = MakeAndPublishVal cenv env (altActualParent, true, declKind, ValNotInRecScope, valscheme, attrs, xmlDoc, literalValue, isGeneratedEventVal)
1315013154

1315113155
PublishArguments cenv env vspec synValSig allDeclaredTypars.Length
1315213156

src/Compiler/CodeGen/IlxGen.fs

Lines changed: 27 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -10903,6 +10903,13 @@ and GenAbstractBinding cenv eenv tref (vref: ValRef) =
1090310903
| SynMemberKind.Constructor
1090410904
| SynMemberKind.Member ->
1090510905
let mdef = mdef.With(customAttrs = mkILCustomAttrs ilAttrs)
10906+
10907+
let mdef =
10908+
if vref.Deref.val_flags.IsGeneratedEventVal then
10909+
mdef.WithSpecialName
10910+
else
10911+
mdef
10912+
1090610913
[ mdef ], [], []
1090710914
| SynMemberKind.PropertyGetSet -> error (Error(FSComp.SR.ilUnexpectedGetSetAnnotation (), m))
1090810915
| SynMemberKind.PropertySet
@@ -11927,6 +11934,17 @@ and GenTypeDef cenv mgbuf lazyInitInfo eenv m (tycon: Tycon) : ILTypeRef option
1192711934
//
1192811935
// Also discard the F#-compiler supplied implementation of the Empty, IsEmpty, Value and None properties.
1192911936

11937+
let nullaryCaseNames =
11938+
if cuinfo.HasHelpers = AllHelpers || cuinfo.HasHelpers = NoHelpers then
11939+
cuinfo.UnionCases
11940+
|> Array.choose (fun alt -> if alt.IsNullary then Some alt.Name else None)
11941+
|> Set.ofArray
11942+
else
11943+
Set.empty
11944+
11945+
let isNullaryCaseClash name =
11946+
not nullaryCaseNames.IsEmpty && nullaryCaseNames.Contains name
11947+
1193011948
let tdefDiscards =
1193111949
Some(
1193211950
(fun (md: ILMethodDef) ->
@@ -11935,15 +11953,22 @@ and GenTypeDef cenv mgbuf lazyInitInfo eenv m (tycon: Tycon) : ILTypeRef option
1193511953
|| (cuinfo.HasHelpers = SpecialFSharpOptionHelpers
1193611954
&& (md.Name = "get_Value" || md.Name = "get_None" || md.Name = "Some"))
1193711955
|| (cuinfo.HasHelpers = AllHelpers
11938-
&& (md.Name.StartsWith("get_Is") && not (tdef2.Methods.FindByName(md.Name).IsEmpty)))),
11956+
&& (md.Name.StartsWith("get_Is") && not (tdef2.Methods.FindByName(md.Name).IsEmpty)))
11957+
|| (md.Name.StartsWith("get_")
11958+
&& md.Name.Length > 4
11959+
&& isNullaryCaseClash (md.Name.Substring(4))
11960+
&& not (tdef2.Methods.FindByName(md.Name).IsEmpty))),
1193911961

1194011962
(fun (pd: ILPropertyDef) ->
1194111963
(cuinfo.HasHelpers = SpecialFSharpListHelpers
1194211964
&& (pd.Name = "Empty" || pd.Name = "IsEmpty"))
1194311965
|| (cuinfo.HasHelpers = SpecialFSharpOptionHelpers
1194411966
&& (pd.Name = "Value" || pd.Name = "None"))
1194511967
|| (cuinfo.HasHelpers = AllHelpers
11946-
&& (pd.Name.StartsWith("Is") && not (tdef2.Properties.LookupByName(pd.Name).IsEmpty))))
11968+
&& (pd.Name.StartsWith("Is") && not (tdef2.Properties.LookupByName(pd.Name).IsEmpty)))
11969+
|| (isNullaryCaseClash pd.Name
11970+
&& (not (tdef2.Properties.LookupByName(pd.Name).IsEmpty)
11971+
|| not (tdef2.Methods.FindByName("get_" + pd.Name).IsEmpty))))
1194711972
)
1194811973

1194911974
tdef2, tdefDiscards
Lines changed: 289 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,289 @@
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+
9+
module CodeGenRegressions_TypeDefs =
10+
11+
// https://github.com/dotnet/fsharp/issues/16565
12+
[<Fact>]
13+
let ``Issue_16565_DefaultAugmentationFalseDuplicateEntry`` () =
14+
let source = """
15+
module Test
16+
17+
open System
18+
19+
[<DefaultAugmentation(false)>]
20+
type Option<'T> =
21+
| Some of Value: 'T
22+
| None
23+
24+
member x.Value =
25+
match x with
26+
| Some x -> x
27+
| None -> raise (new InvalidOperationException("Option.Value"))
28+
29+
static member None : Option<'T> = None
30+
31+
and 'T option = Option<'T>
32+
33+
let v = Option.Some 42
34+
printfn "Value: %d" v.Value
35+
let n = Option<int>.None
36+
printfn "None created successfully"
37+
"""
38+
FSharp source
39+
|> asExe
40+
|> compile
41+
|> shouldSucceed
42+
|> run
43+
|> shouldSucceed
44+
|> ignore
45+
46+
// https://github.com/dotnet/fsharp/issues/14321
47+
[<Fact>]
48+
let ``Issue_14321_DuAndIWSAMNames`` () =
49+
let source = """
50+
module Test
51+
52+
#nowarn "3535" // IWSAM warning
53+
54+
type EngineError<'e> =
55+
static abstract Overheated : 'e
56+
static abstract LowOil : 'e
57+
58+
type CarError =
59+
| Overheated
60+
| LowOil
61+
| DeviceNotPaired
62+
63+
interface EngineError<CarError> with
64+
static member Overheated = Overheated
65+
static member LowOil = LowOil
66+
"""
67+
FSharp source
68+
|> asLibrary
69+
|> compile
70+
|> shouldSucceed
71+
|> ignore
72+
73+
// https://github.com/dotnet/fsharp/issues/14321
74+
// Runtime test: type must load without "duplicate entry in method table"
75+
[<Fact>]
76+
let ``Issue_14321_DuAndIWSAMNames_Runtime`` () =
77+
let source = """
78+
module Test
79+
80+
#nowarn "3535"
81+
82+
type EngineError<'e> =
83+
static abstract Overheated : 'e
84+
static abstract LowOil : 'e
85+
86+
type CarError =
87+
| Overheated
88+
| LowOil
89+
| DeviceNotPaired
90+
91+
interface EngineError<CarError> with
92+
static member Overheated = Overheated
93+
static member LowOil = LowOil
94+
95+
[<EntryPoint>]
96+
let main _ =
97+
let err = CarError.Overheated
98+
match err with
99+
| Overheated -> printfn "Got Overheated"
100+
| LowOil -> printfn "Got LowOil"
101+
| DeviceNotPaired -> printfn "Got DeviceNotPaired"
102+
0
103+
"""
104+
FSharp source
105+
|> asExe
106+
|> compile
107+
|> shouldSucceed
108+
|> run
109+
|> shouldSucceed
110+
|> ignore
111+
112+
// https://github.com/dotnet/fsharp/issues/5834
113+
[<Fact>]
114+
let ``Issue_5834_EventSpecialname`` () =
115+
let source = """
116+
module Test
117+
118+
open System
119+
open System.Reflection
120+
121+
type IAbstract1 =
122+
[<CLIEvent>]
123+
abstract member Event : IEvent<EventHandler, EventArgs>
124+
125+
type IAbstract2 =
126+
[<CLIEvent>]
127+
abstract member Event : IDelegateEvent<EventHandler>
128+
129+
[<AbstractClass>]
130+
type Abstract3() =
131+
[<CLIEvent>]
132+
abstract member Event : IDelegateEvent<EventHandler>
133+
134+
type Concrete1() =
135+
let event = new Event<EventHandler, EventArgs>()
136+
[<CLIEvent>]
137+
member this.Event = event.Publish
138+
139+
type Concrete2() =
140+
[<CLIEvent>]
141+
member this.Event = { new IDelegateEvent<EventHandler> with
142+
member this.AddHandler _ = ()
143+
member this.RemoveHandler _ = () }
144+
145+
type ConcreteWithObsolete() =
146+
let evt = new Event<EventHandler, EventArgs>()
147+
[<Obsolete("deprecated")>]
148+
[<CLIEvent>]
149+
member this.MyEvent = evt.Publish
150+
151+
[<EntryPoint>]
152+
let main _ =
153+
let mutable failures = 0
154+
let check (t: Type) =
155+
t.GetMethods(BindingFlags.Public ||| BindingFlags.Instance ||| BindingFlags.DeclaredOnly)
156+
|> Array.filter (fun m -> m.Name.Contains("Event"))
157+
|> Array.iter (fun m ->
158+
if not m.IsSpecialName then
159+
printfn "FAIL: %s.%s missing specialname" t.Name m.Name
160+
failures <- failures + 1)
161+
162+
check typeof<IAbstract1>
163+
check typeof<IAbstract2>
164+
check typeof<Abstract3>
165+
check typeof<Concrete1>
166+
check typeof<Concrete2>
167+
check typeof<ConcreteWithObsolete>
168+
169+
if failures > 0 then
170+
failwithf "BUG: %d event accessors missing specialname" failures
171+
printfn "SUCCESS: All event accessors have specialname"
172+
0
173+
"""
174+
FSharp source
175+
|> asExe
176+
|> compile
177+
|> shouldSucceed
178+
|> run
179+
|> shouldSucceed
180+
|> ignore
181+
182+
// https://github.com/dotnet/fsharp/issues/5834
183+
// IL verification: abstract event accessors must have specialname flag
184+
[<Fact>]
185+
let ``Issue_5834_EventSpecialname_IL`` () =
186+
let source = """
187+
module Test
188+
189+
open System
190+
191+
type IAbstract1 =
192+
[<CLIEvent>]
193+
abstract member Event : IEvent<EventHandler, EventArgs>
194+
195+
[<AbstractClass>]
196+
type Abstract2() =
197+
[<CLIEvent>]
198+
abstract member Event : IDelegateEvent<EventHandler>
199+
"""
200+
FSharp source
201+
|> asLibrary
202+
|> compile
203+
|> shouldSucceed
204+
|> verifyIL [
205+
// Interface abstract event accessors have specialname
206+
""".method public hidebysig specialname abstract virtual instance void add_Event(class [runtime]System.EventHandler A_1) cil managed"""
207+
208+
""".method public hidebysig specialname abstract virtual instance void remove_Event(class [runtime]System.EventHandler A_1) cil managed"""
209+
210+
// IAbstract1 event references its accessors
211+
""".addon instance void Test/IAbstract1::add_Event(class [runtime]System.EventHandler)"""
212+
""".removeon instance void Test/IAbstract1::remove_Event(class [runtime]System.EventHandler)"""
213+
214+
// Abstract2 event also references its specialname accessors
215+
""".addon instance void Test/Abstract2::add_Event(class [runtime]System.EventHandler)"""
216+
""".removeon instance void Test/Abstract2::remove_Event(class [runtime]System.EventHandler)"""
217+
]
218+
|> ignore
219+
220+
// https://github.com/dotnet/fsharp/issues/14321
221+
// IL verification: DU case properties and IWSAM implementations coexist without duplicates
222+
[<Fact>]
223+
let ``Issue_14321_DuAndIWSAMNames_IL`` () =
224+
let source = """
225+
module Test
226+
227+
#nowarn "3535"
228+
229+
type EngineError<'e> =
230+
static abstract Overheated : 'e
231+
static abstract LowOil : 'e
232+
233+
type CarError =
234+
| Overheated
235+
| LowOil
236+
| DeviceNotPaired
237+
238+
interface EngineError<CarError> with
239+
static member Overheated = Overheated
240+
static member LowOil = LowOil
241+
"""
242+
FSharp source
243+
|> asLibrary
244+
|> compile
245+
|> shouldSucceed
246+
|> verifyIL [
247+
// DU case property getter exists on CarError
248+
""".method public static class Test/CarError get_Overheated() cil managed"""
249+
250+
// Explicit IWSAM implementation uses mangled name
251+
""".method public hidebysig specialname static class Test/CarError 'Test.EngineError<Test.CarError>.get_Overheated'() cil managed"""
252+
253+
// Explicit IWSAM for LowOil also present
254+
""".method public hidebysig specialname static class Test/CarError 'Test.EngineError<Test.CarError>.get_LowOil'() cil managed"""
255+
]
256+
|> ignore
257+
258+
// https://github.com/dotnet/fsharp/issues/16565
259+
// IL verification: DefaultAugmentation(false) produces no duplicate method table entries
260+
[<Fact>]
261+
let ``Issue_16565_DefaultAugmentationFalseDuplicateEntry_IL`` () =
262+
let source = """
263+
module Test
264+
265+
[<DefaultAugmentation(false)>]
266+
type MyOption<'T> =
267+
| Some of Value: 'T
268+
| None
269+
270+
member x.Value =
271+
match x with
272+
| Some x -> x
273+
| None -> failwith "no value"
274+
275+
static member None : MyOption<'T> = None
276+
"""
277+
FSharp source
278+
|> asLibrary
279+
|> compile
280+
|> shouldSucceed
281+
|> verifyIL [
282+
// The user-defined get_Value method exists on the main type with specialname
283+
""".method public hidebysig specialname instance !T get_Value() cil managed"""
284+
285+
// The static get_None method exists
286+
""".method public static class Test/MyOption`1<!T> get_None() cil managed"""
287+
]
288+
|> ignore
289+

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="EmittedIL\CodeGenRegressions\CodeGenRegressions_Signatures.fs" />
284285
<Compile Include="EmittedIL\CodeGenRegressions\CodeGenRegressions_Closures.fs" />
285286
<Compile Include="ErrorMessages\TypedInterpolatedStringsTests.fs" />

0 commit comments

Comments
 (0)