[Repo Assist] Fix generative delegate type support; implement GetInterface on ProvidedTypeDefinition

src/ProvidedTypes.fs

@@ -1657,9 +1657,15 @@ and ProvidedTypeDefinition(isTgt: bool, container:TypeContainer, className: stri
             let xs = this.GetNestedTypes bindingFlags |> Array.filter (fun m -> m.Name = name)
             if xs.Length > 0 then xs.[0] else null)
 
-    override __.GetInterface(_name, _ignoreCase) = notRequired this "GetInterface" this.Name
+    override __.GetInterface(name, ignoreCase) =
+        let sc = if ignoreCase then StringComparison.OrdinalIgnoreCase else StringComparison.Ordinal
+        this.GetInterfaces()
+        |> Array.tryFind (fun t ->
+            if name.Contains(".") then String.Equals(t.FullName, name, sc)
+            else String.Equals(t.Name, name, sc))
+        |> Option.toObj
 
-    override __.GetInterfaces() = getInterfaces()  
+    override __.GetInterfaces() = getInterfaces()
 
 
     override __.MakeArrayType() = ProvidedTypeSymbol(ProvidedTypeSymbolKind.SDArray, [this], typeBuilder) :> Type
@@ -8148,7 +8154,13 @@ namespace ProviderImplementation.ProvidedTypes
         override this.GetCustomAttributes(_inherited) = notRequired this "GetCustomAttributes" inp.Name
         override this.GetCustomAttributes(_attributeType, _inherited) = notRequired this "GetCustomAttributes" inp.Name
         override this.IsDefined(_attributeType, _inherited) = notRequired this "IsDefined" inp.Name
-        override this.GetInterface(_name, _ignoreCase) = notRequired this "GetInterface" inp.Name
+        override this.GetInterface(name, ignoreCase) =
+            let sc = if ignoreCase then StringComparison.OrdinalIgnoreCase else StringComparison.Ordinal
+            this.GetInterfaces()
+            |> Array.tryFind (fun t ->
+                if name.Contains(".") then String.Equals(t.FullName, name, sc)
+                else String.Equals(t.Name, name, sc))
+            |> Option.toObj
         override this.GetElementType() = notRequired this "GetElementType" inp.Name
         override this.InvokeMember(_name, _invokeAttr, _binder, _target, _args, _modifiers, _culture, _namedParameters) = notRequired this "InvokeMember" inp.Name
 
@@ -13971,6 +13983,7 @@ namespace ProviderImplementation.ProvidedTypes
         member __.DefineGenericParameter(name, attrs) =  let eb = ILGenericParameterBuilder(name, attrs) in gparams.Add eb; eb
         member __.DefineParameter(i, attrs, parameterName) =  ilParams.[i].SetData(attrs, parameterName) ; ilParams.[i]
         member __.SetCustomAttribute(ca) = cattrs.Add(ca)
+        member __.SetImplementationFlags(f: MethodImplAttributes) = implflags <- f
         member __.GetILGenerator() = let ilg = ILGenerator(methodName) in body <- Some ilg; ilg
         member __.FormalMethodRef = 
             let cc = (if ILMethodDef.ComputeIsStatic attrs then ILCallingConv.Static else ILCallingConv.Instance)
@@ -15767,6 +15780,7 @@ namespace ProviderImplementation.ProvidedTypes
                 match ptdT with
                 | None -> ()
                 | Some ptdT ->
+                    let isDelegateType = ptdT.BaseType <> null && ptdT.BaseType.FullName = "System.MulticastDelegate"
                     for cinfo in ptdT.GetConstructors(bindAll) do
                         match cinfo with
                         | :? ProvidedConstructor as pcinfo when not (ctorMap.ContainsKey pcinfo)  ->
@@ -15779,6 +15793,9 @@ namespace ProviderImplementation.ProvidedTypes
                                     for (i, p) in cinfo.GetParameters() |> Seq.mapi (fun i x -> (i, x)) do
                                         cb.DefineParameter(i+1, ParameterAttributes.None, p.Name) |> ignore
                                     cb
+                            // Delegate constructors use Runtime implementation; they have no IL body
+                            if isDelegateType then
+                                cb.SetImplementationFlags(MethodImplAttributes.Runtime ||| MethodImplAttributes.Managed)
                             ctorMap.[pcinfo] <- cb
                         | _ -> ()
 
@@ -15826,6 +15843,9 @@ namespace ProviderImplementation.ProvidedTypes
 
                                     pb.SetConstant p.RawDefaultValue
 
+                            // Delegate methods use Runtime implementation; they have no IL body
+                            if isDelegateType then
+                                mb.SetImplementationFlags(MethodImplAttributes.Runtime ||| MethodImplAttributes.Managed)
                             methMap.[pminfo] <- mb
 
                         | _ -> ()
@@ -15841,6 +15861,10 @@ namespace ProviderImplementation.ProvidedTypes
 
                     defineCustomAttrs tb.SetCustomAttribute (ptdT.GetCustomAttributesData())
 
+                    // Delegate types (base = System.MulticastDelegate) use Runtime implementation; their
+                    // constructor and Invoke/BeginInvoke/EndInvoke bodies are synthesised by the CLR.
+                    let isDelegateType = ptdT.BaseType <> null && ptdT.BaseType.FullName = "System.MulticastDelegate"
+
                     // Allow at most one constructor, and use its arguments as the fields of the type
                     let ctors =
                         ptdT.GetConstructors(bindAll) // exclude type initializer
@@ -15866,6 +15890,9 @@ namespace ProviderImplementation.ProvidedTypes
 
                         defineCustomAttrs cb.SetCustomAttribute (pcinfo.GetCustomAttributesData())
 
+                        // Delegate constructors have Runtime implementation; the CLR synthesises the body
+                        if isDelegateType then () else
+
                         let ilg = cb.GetILGenerator()
                         let ctorLocals = Dictionary<Var, ILLocalBuilder>()
                         let parameterVars =
@@ -15932,6 +15959,10 @@ namespace ProviderImplementation.ProvidedTypes
                             [ for v in parameterVars -> Expr.Var v ]
 
                         match pminfo.GetInvokeCode with
+                        | _ when isDelegateType ->
+                            // Delegate methods (Invoke, BeginInvoke, EndInvoke) have Runtime implementation;
+                            // the CLR synthesises their bodies. No IL is emitted.
+                            ()
                         | Some _ when ptdT.IsInterface ->
                             failwith "The provided type definition is an interface; therefore, it should not define an implementation for its members."
                         | Some _ when pminfo.IsAbstract ->

tests/FSharp.TypeProviders.SDK.Tests.fsproj

@@ -21,6 +21,7 @@
     <Compile Include="GenerativeEqualityComparisonTests.fs" />
     <Compile Include="GenerativeStructProvisionTests.fs" />
     <Compile Include="GenerativeEventsTests.fs" />
+    <Compile Include="GenerativeDelegateTests.fs" />
     <Compile Include="ReferencedAssemblies.fs" />
   </ItemGroup>
   <ItemGroup>

tests/GenerativeDelegateTests.fs

@@ -0,0 +1,128 @@
+module TPSDK.GenerativeDelegateTests
+
+#nowarn "760" // IDisposable needs new
+
+open System
+open System.Reflection
+open Microsoft.FSharp.Core.CompilerServices
+open Xunit
+open ProviderImplementation.ProvidedTypes
+open ProviderImplementation.ProvidedTypesTesting
+
+/// Type provider that creates a container type with two custom delegate types:
+///   - SimpleHandler : delegate void SimpleHandler(object sender, EventArgs e)
+///   - ValueHandler  : delegate int ValueHandler(int x, int y)
+[<TypeProvider>]
+type GenerativeDelegatesProvider (config: TypeProviderConfig) as this =
+    inherit TypeProviderForNamespaces (config)
+
+    let ns = "Delegates.Provided"
+    let tempAssembly = ProvidedAssembly()
+    let container = ProvidedTypeDefinition(tempAssembly, ns, "Container", Some typeof<obj>, isErased = false)
+
+    do
+        // --- SimpleHandler: void(object, EventArgs) ---
+        let simpleHandler = ProvidedTypeDefinition("SimpleHandler", Some typeof<System.MulticastDelegate>, isErased = false)
+        simpleHandler.AddMember(
+            ProvidedConstructor(
+                [ ProvidedParameter("object", typeof<obj>)
+                  ProvidedParameter("method", typeof<nativeint>) ],
+                invokeCode = fun _ -> <@@ () @@>))
+        let invokeSimple = ProvidedMethod("Invoke",
+            [ ProvidedParameter("sender", typeof<obj>)
+              ProvidedParameter("e", typeof<EventArgs>) ],
+            typeof<Void>)
+        simpleHandler.AddMember invokeSimple
+        container.AddMember simpleHandler
+
+        // --- ValueHandler: int(int, int) ---
+        let valueHandler = ProvidedTypeDefinition("ValueHandler", Some typeof<System.MulticastDelegate>, isErased = false)
+        valueHandler.AddMember(
+            ProvidedConstructor(
+                [ ProvidedParameter("object", typeof<obj>)
+                  ProvidedParameter("method", typeof<nativeint>) ],
+                invokeCode = fun _ -> <@@ () @@>))
+        let invokeValue = ProvidedMethod("Invoke",
+            [ ProvidedParameter("x", typeof<int>)
+              ProvidedParameter("y", typeof<int>) ],
+            typeof<int>)
+        valueHandler.AddMember invokeValue
+        container.AddMember valueHandler
+
+        tempAssembly.AddTypes [container]
+        this.AddNamespace(ns, [container])
+
+let loadTestAssembly () =
+    let runtimeAssemblyRefs = Targets.DotNetStandard20FSharpRefs()
+    let runtimeAssembly = runtimeAssemblyRefs.[0]
+    let cfg = Testing.MakeSimulatedTypeProviderConfig (__SOURCE_DIRECTORY__, runtimeAssembly, runtimeAssemblyRefs)
+    let tp = GenerativeDelegatesProvider(cfg) :> TypeProviderForNamespaces
+    let providedNamespace = tp.Namespaces.[0]
+    let providedType = providedNamespace.GetTypes().[0] :?> ProvidedTypeDefinition
+    Assert.Equal("Container", providedType.Name)
+    let bytes = (tp :> ITypeProvider).GetGeneratedAssemblyContents(providedType.Assembly)
+    Assembly.Load bytes
+
+[<Fact>]
+let ``Generative delegate type is present in generated assembly``() =
+    let assembly = loadTestAssembly ()
+    let containerType = assembly.ExportedTypes |> Seq.find (fun t -> t.Name = "Container")
+    let delegateType = containerType.GetNestedType("SimpleHandler")
+    Assert.NotNull(delegateType)
+    Assert.True(delegateType.IsClass, "SimpleHandler should be a class")
+    Assert.Equal("System.MulticastDelegate", delegateType.BaseType.FullName)
+
+[<Fact>]
+let ``Generative delegate type has correct constructor``() =
+    let assembly = loadTestAssembly ()
+    let containerType = assembly.ExportedTypes |> Seq.find (fun t -> t.Name = "Container")
+    let delegateType = containerType.GetNestedType("SimpleHandler")
+    Assert.NotNull(delegateType)
+    let ctor = delegateType.GetConstructor([| typeof<obj>; typeof<nativeint> |])
+    Assert.NotNull(ctor)
+    let ps = ctor.GetParameters()
+    Assert.Equal(2, ps.Length)
+    Assert.Equal(typeof<obj>, ps.[0].ParameterType)
+    Assert.Equal(typeof<nativeint>, ps.[1].ParameterType)
+
+[<Fact>]
+let ``Generative delegate Invoke method has correct signature``() =
+    let assembly = loadTestAssembly ()
+    let containerType = assembly.ExportedTypes |> Seq.find (fun t -> t.Name = "Container")
+    let delegateType = containerType.GetNestedType("SimpleHandler")
+    Assert.NotNull(delegateType)
+    let invoke = delegateType.GetMethod("Invoke")
+    Assert.NotNull(invoke)
+    let ps = invoke.GetParameters()
+    Assert.Equal(2, ps.Length)
+    Assert.Equal("sender", ps.[0].Name)
+    Assert.Equal(typeof<obj>, ps.[0].ParameterType)
+    Assert.Equal("e", ps.[1].Name)
+    Assert.Equal(typeof<EventArgs>, ps.[1].ParameterType)
+    Assert.Equal(typeof<Void>, invoke.ReturnType)
+
+[<Fact>]
+let ``Generative delegate with value return type has correct Invoke signature``() =
+    let assembly = loadTestAssembly ()
+    let containerType = assembly.ExportedTypes |> Seq.find (fun t -> t.Name = "Container")
+    let delegateType = containerType.GetNestedType("ValueHandler")
+    Assert.NotNull(delegateType)
+    Assert.Equal("System.MulticastDelegate", delegateType.BaseType.FullName)
+    let invoke = delegateType.GetMethod("Invoke")
+    Assert.NotNull(invoke)
+    let ps = invoke.GetParameters()
+    Assert.Equal(2, ps.Length)
+    Assert.Equal(typeof<int>, ps.[0].ParameterType)
+    Assert.Equal(typeof<int>, ps.[1].ParameterType)
+    Assert.Equal(typeof<int>, invoke.ReturnType)
+
+[<Fact>]
+let ``Multiple delegate types can coexist in one container``() =
+    let assembly = loadTestAssembly ()
+    let containerType = assembly.ExportedTypes |> Seq.find (fun t -> t.Name = "Container")
+    let nested = containerType.GetNestedTypes()
+    let names = nested |> Array.map (fun t -> t.Name) |> Array.sort
+    Assert.Contains("SimpleHandler", names)
+    Assert.Contains("ValueHandler", names)
+    for t in nested do
+        Assert.Equal("System.MulticastDelegate", t.BaseType.FullName)