diff --git a/docs/release-notes/.FSharp.Compiler.Service/11.0.100.md b/docs/release-notes/.FSharp.Compiler.Service/11.0.100.md index 4df01e7ceb0..e981f0bf2eb 100644 --- a/docs/release-notes/.FSharp.Compiler.Service/11.0.100.md +++ b/docs/release-notes/.FSharp.Compiler.Service/11.0.100.md @@ -106,6 +106,7 @@ * Fix internal error `FS0192: encodeCustomAttrElemType` when using arrays of user-defined types as custom attribute arguments. Empty arrays (e.g. `[]`) now compile successfully; non-empty arrays of unencodable types report a proper diagnostic (FS3887) instead of an internal error. ([Issue #12796](https://github.com/dotnet/fsharp/issues/12796), [PR #19472](https://github.com/dotnet/fsharp/pull/19472)) * Cleanup in IL base-call checking: skip `resolveILMethodRefWithRescope` when the method is not declared on the immediate IL type, instead of relying on the `try/with` around a `failwith`. `FS1201` still applies when the abstract member is declared on the immediate IL base. ([Issue #20264](https://github.com/dotnet/fsharp/issues/20264), [PR #20272](https://github.com/dotnet/fsharp/pull/20272)) * Fix internal compiler error in `use` bindings when a C#-style `Dispose` extension method is in scope alongside `IDisposable.Dispose`. ([Issue #19552](https://github.com/dotnet/fsharp/issues/19552), [PR #19568](https://github.com/dotnet/fsharp/pull/19568)) +* Fix `MethodImpl` and `PreserveSig` attributes on property accessors to emit method implementation flags instead of real custom attributes. ([Issue #20288](https://github.com/dotnet/fsharp/issues/20288), [PR #20558](https://github.com/dotnet/fsharp/pull/20558)) * Fix signature generation: single-case struct DU gets spurious bar causing FS0300. ([Issue #19597](https://github.com/dotnet/fsharp/issues/19597), [PR #19609](https://github.com/dotnet/fsharp/pull/19609)) * Fix signature generation: backticked active pattern case names lose escaping. ([Issue #19592](https://github.com/dotnet/fsharp/issues/19592), [PR #19609](https://github.com/dotnet/fsharp/pull/19609)) * Fix signature generation: `namespace global` header dropped from generated signature. ([Issue #19593](https://github.com/dotnet/fsharp/issues/19593), [PR #19609](https://github.com/dotnet/fsharp/pull/19609)) diff --git a/src/Compiler/CodeGen/IlxGen.fs b/src/Compiler/CodeGen/IlxGen.fs index ae028f41cd4..f18d5b22adc 100644 --- a/src/Compiler/CodeGen/IlxGen.fs +++ b/src/Compiler/CodeGen/IlxGen.fs @@ -9999,9 +9999,6 @@ and GenMethodForBinding (WellKnownValAttributes.DllImportAttribute ||| WellKnownValAttributes.CompiledNameAttribute) - let attrsAppliedToGetterOrSetter, attrs = - List.partition (fun (Attrib(_, _, _, _, isAppliedToGetterOrSetter, _, _)) -> isAppliedToGetterOrSetter) attrs - let sourceNameAttribs, compiledName = match tryFindValAttribByFlag g WellKnownValAttributes.CompiledNameAttribute v.Attribs with | Some(Attrib(_, _, [ AttribStringArg b ], _, _, _, _)) -> [ mkCompilationSourceNameAttr g v.LogicalName ], Some b @@ -10011,6 +10008,9 @@ and GenMethodForBinding let hasPreserveSigImplFlag, hasSynchronizedImplFlag, hasNoInliningFlag, hasAggressiveInliningImplFlag, attrs = ComputeMethodImplAttribs cenv v attrs + let attrsAppliedToGetterOrSetter, attrs = + List.partition (fun (Attrib(_, _, _, _, isAppliedToGetterOrSetter, _, _)) -> isAppliedToGetterOrSetter) attrs + let securityAttributes, attrs = attrs |> List.partition (fun a -> IsSecurityAttribute g cenv.amap cenv.casApplied a m) diff --git a/tests/FSharp.Compiler.ComponentTests/EmittedIL/MethodImplAttribute/MethodImplAttribute.fs b/tests/FSharp.Compiler.ComponentTests/EmittedIL/MethodImplAttribute/MethodImplAttribute.fs index 0c4e437999b..cd99c0bc5d8 100644 --- a/tests/FSharp.Compiler.ComponentTests/EmittedIL/MethodImplAttribute/MethodImplAttribute.fs +++ b/tests/FSharp.Compiler.ComponentTests/EmittedIL/MethodImplAttribute/MethodImplAttribute.fs @@ -1,5 +1,7 @@ namespace EmittedIL +open System.Reflection +open System.Reflection.Metadata open Xunit open FSharp.Test open FSharp.Test.Compiler @@ -80,3 +82,381 @@ module MethodImplAttribute = compilation |> getCompilation |> verifyCompilation + + let private verifyMetadata expectedMethods expectedProperties compilation = + compilation + |> asLibrary + |> compile + |> shouldSucceed + |> withMetadataReader (fun reader -> + let qualify ns name = + if ns = "" then name else ns + "." + name + + let rec typeName (handle: EntityHandle) = + match handle.Kind with + | HandleKind.TypeDefinition -> + let def = reader.GetTypeDefinition(TypeDefinitionHandle.op_Explicit handle) + let name = reader.GetString def.Name + let parent = def.GetDeclaringType() + + if parent.IsNil then + qualify (reader.GetString def.Namespace) name + else + typeName (TypeDefinitionHandle.op_Implicit parent) + "+" + name + | HandleKind.TypeReference -> + let reference = reader.GetTypeReference(TypeReferenceHandle.op_Explicit handle) + qualify (reader.GetString reference.Namespace) (reader.GetString reference.Name) + | kind -> failwithf "Unexpected attribute/type handle: %A" kind + + let attributes handles = + [ + for handle in handles do + let attribute = reader.GetCustomAttribute handle + + let parent = + match attribute.Constructor.Kind with + | HandleKind.MemberReference -> + reader.GetMemberReference(MemberReferenceHandle.op_Explicit attribute.Constructor).Parent + | HandleKind.MethodDefinition -> + let ctor = + reader.GetMethodDefinition(MethodDefinitionHandle.op_Explicit attribute.Constructor) + + TypeDefinitionHandle.op_Implicit (ctor.GetDeclaringType()) + | kind -> failwithf "Unexpected attribute constructor: %A" kind + + yield typeName parent + ] + + let exactlyOne identity items = + match Seq.toList items with + | [ item ] -> item + | items -> failwithf "Expected exactly one %s; found %d" identity items.Length + + let findType name = + reader.TypeDefinitions + |> Seq.filter (fun handle -> typeName (TypeDefinitionHandle.op_Implicit handle) = name) + |> exactlyOne name + |> reader.GetTypeDefinition + + let markers = + [ + "Markers.PropertyMarkerAttribute" + "Markers.GetterMarkerAttribute" + "Markers.SetterMarkerAttribute" + ] + + let markerAttributes = + List.filter (fun name -> List.contains name markers) >> List.sort + + let pseudoAttributes = + List.filter (fun name -> + name = "System.Runtime.CompilerServices.MethodImplAttribute" + || name = "System.Runtime.InteropServices.PreserveSigAttribute") + >> List.sort + + let actualMethods = + [ + for declaringType, name, _, isStatic, _ in expectedMethods do + let identity = declaringType + "." + name + + let methods = + (findType declaringType).GetMethods() + |> Seq.map reader.GetMethodDefinition + |> Seq.toList + + let methodDef = + methods + |> List.filter (fun def -> reader.GetString def.Name = name) + |> exactlyOne ( + sprintf "%s (available: %A)" identity (methods |> List.map (fun def -> reader.GetString def.Name)) + ) + + Assert.False(methodDef.Attributes.HasFlag MethodAttributes.Abstract, identity) + Assert.True(methodDef.RelativeVirtualAddress <> 0, identity + " must have a body") + Assert.True(methodDef.Attributes.HasFlag MethodAttributes.Static = isStatic, identity + " static flag") + let attrs = attributes (methodDef.GetCustomAttributes()) + yield identity, int methodDef.ImplAttributes, pseudoAttributes attrs, markerAttributes attrs + ] + + let expectedMethods = + [ + for declaringType, name, flags, _, markers in expectedMethods do + yield declaringType + "." + name, flags, [], List.sort markers + ] + + Assert.True( + (expectedMethods = actualMethods), + sprintf "Expected metadata:\n%A\nActual metadata:\n%A" expectedMethods actualMethods + ) + + for declaringType, name, expectedMarkers in expectedProperties do + let identity = declaringType + "." + name + + let property = + (findType declaringType).GetProperties() + |> Seq.map reader.GetPropertyDefinition + |> Seq.filter (fun def -> reader.GetString def.Name = name) + |> exactlyOne identity + + let actualMarkers = attributes (property.GetCustomAttributes()) |> markerAttributes + Assert.True(List.sort expectedMarkers = actualMarkers, sprintf "%s markers: %A" identity actualMarkers)) + + let private markerSource = + """ +namespace Markers +open System +[] +type PropertyMarkerAttribute() = inherit Attribute() +[] +type GetterMarkerAttribute() = inherit Attribute() +[] +type SetterMarkerAttribute() = inherit Attribute() +""" + + let private instanceLibrary = + FSharp( + markerSource + + """ +namespace InstanceLibrary +open Markers +open System.Runtime.CompilerServices +type C() = + let mutable value = 1 + [] + member _.P + with [] get () = value + and [] set (v: int) = value <- v + """ + ) + |> asLibrary + |> withName "InstanceLibrary" + + let private interfaceLibrary = + FSharp + """ +namespace InterfaceLibrary +open System.Runtime.CompilerServices +type I = + abstract P: int with get, set +type C() = + let mutable value = 2 + interface I with + member _.P + with [] get () = value + and [] set (v: int) = value <- v +""" + |> asLibrary + |> withName "InterfaceLibrary" + + let private signatureLibrary = + Fsi + """ +module SignatureLibrary +type C = + new: unit -> C + member P: int with get, set +""" + |> withAdditionalSourceFile ( + FsSource + """ +module SignatureLibrary +open System.Runtime.CompilerServices +type C() = + let mutable value = 3 + member _.P + with [] get () = value + and [] set (v: int) = value <- v + """ + ) + |> asLibrary + |> withName "SignatureLibrary" + + [] + [] + [] + [] + [] + [] + [] + let ``Accessor implementation flags are metadata, not custom attributes`` scenario = + let library, methods, properties = + match scenario with + | "issue" -> + FSharp + """ +module P +open System.Runtime.CompilerServices + +[] +type A = + static member P1 with [] get () = 1 + +[] +type B = + static member P2 with [] set (v: int) = ignore v + +[] +type C = + [] + static member M1() = 1 + """, + [ + "P+A", "get_P1", 0x100, true, [] + "P+B", "set_P2", 0x8, true, [] + "P+C", "M1", 0x100, true, [] + ], + [] + | "instance markers" -> + instanceLibrary, + [ + "InstanceLibrary.C", "get_P", 0x100, false, [ "Markers.GetterMarkerAttribute" ] + "InstanceLibrary.C", "set_P", 0xA8, false, [ "Markers.SetterMarkerAttribute" ] + ], + [ "InstanceLibrary.C", "P", [ "Markers.PropertyMarkerAttribute" ] ] + | "standalone PreserveSig" -> + FSharp + """ +namespace Standalone +open System.Runtime.CompilerServices +open System.Runtime.InteropServices +type C() = + member _.P with [] get () = 1 + [] + member _.M() = 1 + """, + [ + "Standalone.C", "get_P", 0x88, false, [] + "Standalone.C", "M", 0x88, false, [] + ], + [] + | "explicit interface" -> + interfaceLibrary, + [ + "InterfaceLibrary.C", "InterfaceLibrary.I.get_P", 0x8, false, [] + "InterfaceLibrary.C", "InterfaceLibrary.I.set_P", 0x20, false, [] + ], + [] + | "extrinsic extension" -> + FSharp( + markerSource + + """ +module Extensions = + open System.Runtime.CompilerServices + type System.String with + member s.P with [] get () = s.Length + """ + ), + [ + "Markers.Extensions", "String.get_P", 0x108, true, [ "Markers.GetterMarkerAttribute" ] + ], + [] + | "neutral signature" -> + signatureLibrary, + [ + "SignatureLibrary+C", "get_P", 0x8, false, [] + "SignatureLibrary+C", "set_P", 0xA0, false, [] + ], + [] + | _ -> failwithf "Unknown accessor scenario: %s" scenario + + library |> verifyMetadata methods properties + + let implementationFlagCases = + [ + for attribute, flags, ordinary in + [ + "MethodImpl(MethodImplOptions.NoInlining)", 0x8, false + "MethodImpl(MethodImplOptions.Synchronized)", 0x20, false + "MethodImpl(MethodImplOptions.PreserveSig)", 0x80, false + "MethodImpl(MethodImplOptions.AggressiveInlining)", 0x100, false + "PreserveSig", 0x80, true + "MethodImpl(MethodImplOptions.NoInlining ||| MethodImplOptions.AggressiveInlining)", 0x108, true + "MethodImpl(MethodImplOptions.ForwardRef)", 0, false + "MethodImpl(MethodImplOptions.InternalCall)", 0, false + "MethodImpl(MethodImplOptions.NoOptimization)", 0, false + "MethodImpl(MethodImplOptions.Unmanaged)", 0, false + "MethodImpl(enum(0x200))", 0, true // AggressiveOptimization is absent on net472. + "MethodImpl(MethodImplOptions.NoInlining, MethodCodeType = MethodCodeType.Native)", 0x8, true + "MethodImpl(8s)", 0, true + "", 0, false + ] do + for accessor in [ true; false ] do + if accessor || ordinary then + yield [| box attribute; box flags; box accessor |] + ] + + [] + let ``Implementation flag compatibility`` attribute flags accessor = + let annotation = if attribute = "" then "" else "[<" + attribute + ">]" + + let memberSource = + if accessor then + "member _.P with " + annotation + " get () = 1" + else + annotation + "\n member _.M() = 1" + + FSharp( + """ +namespace Compatibility +open System.Runtime.CompilerServices +open System.Runtime.InteropServices +type C() = + """ + + memberSource + ) + |> verifyMetadata [ "Compatibility.C", (if accessor then "get_P" else "M"), flags, false, [] ] [] + + [] + let ``Property-level MethodImpl remains warning FS0842 unless promoted`` promote = + let compilation = + FSharp + """ +module InvalidTarget +open System.Runtime.CompilerServices +type C() = + [] + member _.P = 1 +""" + |> asLibrary + + let result, severity = + if promote then + compilation |> withOptions [ "--warnaserror:842" ] |> typecheck |> shouldFail, Error 842 + else + compilation |> ignoreWarnings |> typecheck |> shouldSucceed, Warning 842 + + result + |> withSingleDiagnostic ( + severity, + Line 5, + Col 7, + Line 5, + Col 47, + "This attribute cannot be applied to property, event, return value. Valid targets are: constructor, method" + ) + + [] + let ``External callers can get and set attributed properties`` () = + FSharp + """ +module Consumer +[] +let main _ = + let normal = InstanceLibrary.C() + if normal.P <> 1 then failwith "normal getter" + normal.P <- 11 + if normal.P <> 11 then failwith "normal setter" + let explicit = InterfaceLibrary.C() :> InterfaceLibrary.I + if explicit.P <> 2 then failwith "interface getter" + explicit.P <- 22 + if explicit.P <> 22 then failwith "interface setter" + let constrained = SignatureLibrary.C() + if constrained.P <> 3 then failwith "signature getter" + constrained.P <- 33 + if constrained.P <> 33 then failwith "signature setter" + 0 +""" + |> withReferences [ instanceLibrary; interfaceLibrary; signatureLibrary ] + |> asExe + |> compileExeAndRun + |> shouldSucceed