Bugfix :: Fix type definition metadata: duplicate methods, event flags

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

@@ -1,4 +1,7 @@
 ### Fixed
 
+* 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))
+* 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))
+* 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))
 
 ### Added

src/Compiler/Checking/Expressions/CheckExpressions.fs

@@ -13094,7 +13094,11 @@ let TcAndPublishValSpec (cenv: cenv, env, containerInfo: ContainerInfo, declKind
 
         let checkXmlDocs = cenv.diagnosticOptions.CheckXmlDocs
         let xmlDoc = xmlDoc.ToXmlDoc(checkXmlDocs, paramNames)
-        let vspec = MakeAndPublishVal cenv env (altActualParent, true, declKind, ValNotInRecScope, valscheme, attrs, xmlDoc, literalValue, false)
+        let isGeneratedEventVal =
+            CompileAsEvent g attrs
+            && (id.idText.StartsWithOrdinal("add_") || id.idText.StartsWithOrdinal("remove_"))
+
+        let vspec = MakeAndPublishVal cenv env (altActualParent, true, declKind, ValNotInRecScope, valscheme, attrs, xmlDoc, literalValue, isGeneratedEventVal)
 
         PublishArguments cenv env vspec synValSig allDeclaredTypars.Length
 

src/Compiler/CodeGen/IlxGen.fs

@@ -10767,6 +10767,13 @@ and GenAbstractBinding cenv eenv tref (vref: ValRef) =
         | SynMemberKind.Constructor
         | SynMemberKind.Member ->
             let mdef = mdef.With(customAttrs = mkILCustomAttrs ilAttrs)
+
+            let mdef =
+                if vref.Deref.val_flags.IsGeneratedEventVal then
+                    mdef.WithSpecialName
+                else
+                    mdef
+
             [ mdef ], [], []
         | SynMemberKind.PropertyGetSet -> error (Error(FSComp.SR.ilUnexpectedGetSetAnnotation (), m))
         | SynMemberKind.PropertySet
@@ -11785,6 +11792,17 @@ and GenTypeDef cenv mgbuf lazyInitInfo eenv m (tycon: Tycon) : ILTypeRef option
                     //
                     // Also discard the F#-compiler supplied implementation of the Empty, IsEmpty, Value and None properties.
 
+                    let nullaryCaseNames =
+                        if cuinfo.HasHelpers = AllHelpers || cuinfo.HasHelpers = NoHelpers then
+                            cuinfo.UnionCases
+                            |> Array.choose (fun alt -> if alt.IsNullary then Some alt.Name else None)
+                            |> Set.ofArray
+                        else
+                            Set.empty
+
+                    let isNullaryCaseClash name =
+                        not nullaryCaseNames.IsEmpty && nullaryCaseNames.Contains name
+
                     let tdefDiscards =
                         Some(
                             (fun (md: ILMethodDef) ->
@@ -11793,15 +11811,22 @@ and GenTypeDef cenv mgbuf lazyInitInfo eenv m (tycon: Tycon) : ILTypeRef option
                                 || (cuinfo.HasHelpers = SpecialFSharpOptionHelpers
                                     && (md.Name = "get_Value" || md.Name = "get_None" || md.Name = "Some"))
                                 || (cuinfo.HasHelpers = AllHelpers
-                                    && (md.Name.StartsWith("get_Is") && not (tdef2.Methods.FindByName(md.Name).IsEmpty)))),
+                                    && (md.Name.StartsWith("get_Is") && not (tdef2.Methods.FindByName(md.Name).IsEmpty)))
+                                || (md.Name.StartsWith("get_")
+                                    && md.Name.Length > 4
+                                    && isNullaryCaseClash (md.Name.Substring(4))
+                                    && not (tdef2.Methods.FindByName(md.Name).IsEmpty))),
 
                             (fun (pd: ILPropertyDef) ->
                                 (cuinfo.HasHelpers = SpecialFSharpListHelpers
                                  && (pd.Name = "Empty" || pd.Name = "IsEmpty"))
                                 || (cuinfo.HasHelpers = SpecialFSharpOptionHelpers
                                     && (pd.Name = "Value" || pd.Name = "None"))
                                 || (cuinfo.HasHelpers = AllHelpers
-                                    && (pd.Name.StartsWith("Is") && not (tdef2.Properties.LookupByName(pd.Name).IsEmpty))))
+                                    && (pd.Name.StartsWith("Is") && not (tdef2.Properties.LookupByName(pd.Name).IsEmpty)))
+                                || (isNullaryCaseClash pd.Name
+                                    && (not (tdef2.Properties.LookupByName(pd.Name).IsEmpty)
+                                        || not (tdef2.Methods.FindByName("get_" + pd.Name).IsEmpty))))
                         )
 
                     tdef2, tdefDiscards

tests/FSharp.Compiler.ComponentTests/EmittedIL/CodeGenRegressions/CodeGenRegressions_TypeDefs.fs

@@ -0,0 +1,192 @@
+// Copyright (c) Microsoft Corporation.  All Rights Reserved.  See License.txt in the project root for license information.
+
+namespace EmittedIL
+
+open Xunit
+open FSharp.Test
+open FSharp.Test.Compiler
+open FSharp.Test.Utilities
+
+module CodeGenRegressions_TypeDefs =
+
+    let private getActualIL (result: CompilationResult) =
+        match result with
+        | CompilationResult.Success s ->
+            match s.OutputPath with
+            | Some p ->
+                let (_, _, actualIL) = ILChecker.verifyILAndReturnActual [] p [ "// dummy" ]
+                actualIL
+            | None -> failwith "No output path"
+        | _ -> failwith "Compilation failed"
+
+    // https://github.com/dotnet/fsharp/issues/16565
+    [<Fact>]
+    let ``Issue_16565_DefaultAugmentationFalseDuplicateEntry`` () =
+        let source = """
+module Test
+
+open System
+
+[<DefaultAugmentation(false)>]
+type Option<'T> =
+    | Some of Value: 'T
+    | None
+
+    member x.Value =
+        match x with
+        | Some x -> x
+        | None -> raise (new InvalidOperationException("Option.Value"))
+
+    static member None : Option<'T> = None
+
+and 'T option = Option<'T>
+
+let v = Option.Some 42
+printfn "Value: %d" v.Value
+let n = Option<int>.None
+printfn "None created successfully"
+"""
+        FSharp source
+        |> asExe
+        |> compile
+        |> shouldSucceed
+        |> run
+        |> shouldSucceed
+        |> ignore
+
+    // https://github.com/dotnet/fsharp/issues/14321
+    [<Fact>]
+    let ``Issue_14321_DuAndIWSAMNames`` () =
+        let source = """
+module Test
+
+#nowarn "3535"  // IWSAM warning
+
+type EngineError<'e> =
+    static abstract Overheated : 'e
+    static abstract LowOil : 'e
+
+type CarError =
+    | Overheated
+    | LowOil
+    | DeviceNotPaired
+
+    interface EngineError<CarError> with
+        static member Overheated = Overheated
+        static member LowOil = LowOil
+"""
+        FSharp source
+        |> asLibrary
+        |> compile
+        |> shouldSucceed
+        |> ignore
+
+    // https://github.com/dotnet/fsharp/issues/14321
+    // Runtime test: type must load without "duplicate entry in method table"
+    [<Fact>]
+    let ``Issue_14321_DuAndIWSAMNames_Runtime`` () =
+        let source = """
+module Test
+
+#nowarn "3535"
+
+type EngineError<'e> =
+    static abstract Overheated : 'e
+    static abstract LowOil : 'e
+
+type CarError =
+    | Overheated
+    | LowOil
+    | DeviceNotPaired
+
+    interface EngineError<CarError> with
+        static member Overheated = Overheated
+        static member LowOil = LowOil
+
+[<EntryPoint>]
+let main _ =
+    let err = CarError.Overheated
+    match err with
+    | Overheated -> printfn "Got Overheated"
+    | LowOil -> printfn "Got LowOil"
+    | DeviceNotPaired -> printfn "Got DeviceNotPaired"
+    0
+"""
+        FSharp source
+        |> asExe
+        |> compile
+        |> shouldSucceed
+        |> run
+        |> shouldSucceed
+        |> ignore
+
+    // https://github.com/dotnet/fsharp/issues/5834
+    [<Fact>]
+    let ``Issue_5834_EventSpecialname`` () =
+        let source = """
+module Test
+
+open System
+open System.Reflection
+
+type IAbstract1 =
+    [<CLIEvent>]
+    abstract member Event : IEvent<EventHandler, EventArgs>
+
+type IAbstract2 =
+    [<CLIEvent>]
+    abstract member Event : IDelegateEvent<EventHandler>
+
+[<AbstractClass>]
+type Abstract3() =
+    [<CLIEvent>]
+    abstract member Event : IDelegateEvent<EventHandler>
+
+type Concrete1() =
+    let event = new Event<EventHandler, EventArgs>()
+    [<CLIEvent>]
+    member this.Event = event.Publish
+
+type Concrete2() =
+    [<CLIEvent>]
+    member this.Event = { new IDelegateEvent<EventHandler> with
+                              member this.AddHandler _ = ()
+                              member this.RemoveHandler _ = () }
+
+type ConcreteWithObsolete() =
+    let evt = new Event<EventHandler, EventArgs>()
+    [<Obsolete("deprecated")>]
+    [<CLIEvent>]
+    member this.MyEvent = evt.Publish
+
+[<EntryPoint>]
+let main _ =
+    let mutable failures = 0
+    let check (t: Type) =
+        t.GetMethods(BindingFlags.Public ||| BindingFlags.Instance ||| BindingFlags.DeclaredOnly)
+        |> Array.filter (fun m -> m.Name.Contains("Event"))
+        |> Array.iter (fun m ->
+            if not m.IsSpecialName then
+                printfn "FAIL: %s.%s missing specialname" t.Name m.Name
+                failures <- failures + 1)
+
+    check typeof<IAbstract1>
+    check typeof<IAbstract2>
+    check typeof<Abstract3>
+    check typeof<Concrete1>
+    check typeof<Concrete2>
+    check typeof<ConcreteWithObsolete>
+
+    if failures > 0 then
+        failwithf "BUG: %d event accessors missing specialname" failures
+    printfn "SUCCESS: All event accessors have specialname"
+    0
+"""
+        FSharp source
+        |> asExe
+        |> compile
+        |> shouldSucceed
+        |> run
+        |> shouldSucceed
+        |> ignore
+

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

@@ -280,6 +280,7 @@
     <Compile Include="EmittedIL\Nullness\NullnessMetadata.fs" />
     <Compile Include="EmittedIL\FixedBindings\FixedBindings.fs" />
     <Compile Include="EmittedIL\CodeGenRegressions\CodeGenRegressions_Observations.fs" />
+    <Compile Include="EmittedIL\CodeGenRegressions\CodeGenRegressions_TypeDefs.fs" />
     <Compile Include="ErrorMessages\TypedInterpolatedStringsTests.fs" />
     <!--<Compile Include="EmittedIL\StructDefensiveCopy\StructDefensiveCopy.fs" />-->
     <Compile Include="ErrorMessages\UnsupportedAttributes.fs" />

tests/FSharp.Compiler.Service.Tests/ModuleReaderCancellationTests.fs

@@ -150,6 +150,10 @@ let parseAndCheck path source options =
             | _, FSharpCheckFileAnswer.Aborted -> None
             | _, FSharpCheckFileAnswer.Succeeded results -> Some results
 
+        // Allow time for async cancellation token cleanup on slower platforms (e.g. MacOS CI)
+        if Cancellable.HasCancellationToken then
+            System.Threading.Thread.Sleep(100)
+
         Cancellable.HasCancellationToken |> shouldEqual false
         result