Respect the return qualifier for attributes on class methods

Author: DragonSA

FSharp.sln

@@ -146,6 +146,10 @@ Project("{2150E333-8FDC-42A3-9474-1A3956D46DE8}") = ".FSharp.Compiler.Service",
 		docs\release-notes\.FSharp.Compiler.Service\8.0.400.md = docs\release-notes\.FSharp.Compiler.Service\8.0.400.md
 		docs\release-notes\.FSharp.Compiler.Service\9.0.100.md = docs\release-notes\.FSharp.Compiler.Service\9.0.100.md
 		docs\release-notes\.FSharp.Compiler.Service\9.0.200.md = docs\release-notes\.FSharp.Compiler.Service\9.0.200.md
+		docs\release-notes\.FSharp.Compiler.Service\9.0.202.md = docs\release-notes\.FSharp.Compiler.Service\9.0.202.md
+		docs\release-notes\.FSharp.Compiler.Service\9.0.300.md = docs\release-notes\.FSharp.Compiler.Service\9.0.300.md
+		docs\release-notes\.FSharp.Compiler.Service\10.0.100.md = docs\release-notes\.FSharp.Compiler.Service\10.0.100.md
+		docs\release-notes\.FSharp.Compiler.Service\11.0.0.md = docs\release-notes\.FSharp.Compiler.Service\11.0.0.md
 	EndProjectSection
 EndProject
 Project("{2150E333-8FDC-42A3-9474-1A3956D46DE8}") = ".FSharp.Core", ".FSharp.Core", "{23798638-A1E9-4DAE-9C9C-F5D87499ADD6}"

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

@@ -6,11 +6,12 @@
 * Fix name is bound multiple times is not reported in 'as' pattern ([PR #18984](https://github.com/dotnet/fsharp/pull/18984))
 * Fix: warn FS0049 on upper union case label. ([PR #19003](https://github.com/dotnet/fsharp/pull/19003))
 * Type relations cache: handle potentially "infinite" types ([PR #19010](https://github.com/dotnet/fsharp/pull/19010))  
+* Respect the return qualifier for attributes on class methods ([PR #19025](https://github.com/dotnet/fsharp/pull/19025))
 
 ### Added
 
 ### Changed
 
 * Parallel compilation stabilised and enabled by default ([PR #18998](https://github.com/dotnet/fsharp/pull/18998))
 
-### Breaking Changes
+### Breaking Changes

src/Compiler/Checking/Expressions/CheckExpressions.fs

@@ -10982,47 +10982,15 @@ and TcNormalizedBinding declKind (cenv: cenv) env tpenv overallTy safeThisValOpt
                 false, SynExpr.ObjExpr(targetType, Some(expr, None), None, [], [], [], m, rhsExpr.Range), overallTy, overallTy
             | e -> false, e, overallTy, overallTy
 
-        // Check the attributes of the binding, parameters or return value
-        let TcAttrs tgt isRet attrs =
-            // For all but attributes positioned at the return value, disallow implicitly
-            // targeting the return value.
-            let tgtEx = if isRet then enum 0 else AttributeTargets.ReturnValue
-            let attrs, _ = TcAttributesMaybeFailEx TcCanFail.ReportAllErrors cenv envinner tgt tgtEx attrs
-            let attrs: Attrib list = attrs
-            if attrTgt = enum 0 && not (isNil attrs) then
-                for attr in attrs do
-                    errorR(Error(FSComp.SR.tcAttributesAreNotPermittedOnLetBindings(), attr.Range))
-            attrs
-
         // Rotate [<return:...>] from binding to return value
         // Also patch the syntactic representation
-        let retAttribs, valAttribs, valSynData =
-            let attribs = TcAttrs attrTgt false attrs
-            let rotRetSynAttrs, rotRetAttribs, valAttribs =
-                // Do not rotate if some attrs fail to typecheck...
-                if attribs.Length <> attrs.Length then [], [], attribs
-                else attribs
-                     |> List.zip attrs
-                     |> List.partition(function | _, Attrib(_, _, _, _, _, Some ts, _) -> ts &&& AttributeTargets.ReturnValue <> enum 0 | _ -> false)
-                     |> fun (r, v) -> (List.map fst r, List.map snd r, List.map snd v)
-            let retAttribs =
-                match rtyOpt with
-                | Some (SynBindingReturnInfo(attributes = Attributes retAttrs)) ->
-                    rotRetAttribs @ TcAttrs AttributeTargets.ReturnValue true retAttrs
-                | None -> rotRetAttribs
-            let valSynData =
-                match rotRetSynAttrs with
-                | [] -> valSynData
-                | {Range=mHead} :: _ ->
-                let (SynValData(valMf, SynValInfo(args, SynArgInfo(attrs, opt, retId)), valId)) = valSynData
-                SynValData(valMf, SynValInfo(args, SynArgInfo({Attributes=rotRetSynAttrs; Range=mHead} :: attrs, opt, retId)), valId)
-            retAttribs, valAttribs, valSynData
+        let retAttribs, valAttribs, valSynData = TcNormalizeReturnAttribs cenv envinner attrTgt attrs valSynData rtyOpt
 
         let isVolatile = HasFSharpAttribute g g.attrib_VolatileFieldAttribute valAttribs
         let inlineFlag = ComputeInlineFlag memberFlagsOpt isInline isMutable g valAttribs mBinding
 
         let argAttribs =
-            spatsL |> List.map (SynInfo.InferSynArgInfoFromSimplePats >> List.map (SynInfo.AttribsOfArgData >> TcAttrs AttributeTargets.Parameter false))
+            spatsL |> List.map (SynInfo.InferSynArgInfoFromSimplePats >> List.map (SynInfo.AttribsOfArgData >> TcAttrs cenv envinner attrTgt AttributeTargets.Parameter false))
 
         // Assert the return type of an active pattern. A [<return:Struct>] attribute may be used on a partial active pattern.
         let isStructRetTy = HasFSharpAttribute g g.attrib_StructAttribute retAttribs
@@ -11220,6 +11188,30 @@ and TcNormalizedBinding declKind (cenv: cenv) env tpenv overallTy safeThisValOpt
 
         CheckedBindingInfo(inlineFlag, valAttribs, xmlDoc, tcPatPhase2, explicitTyparInfo, nameToPrelimValSchemeMap, rhsExprChecked, argAndRetAttribs, overallPatTy, mBinding, debugPoint, isCompGen, literalValue, isFixed), tpenv
 
+// Rotate [<return:...>] from binding to return value
+// Also patch the syntactic representation
+and TcNormalizeReturnAttribs cenv env attrTgt attrs valSynData rtyOpt =
+    let attribs = TcAttrs cenv env attrTgt attrTgt false attrs
+    let rotRetSynAttrs, rotRetAttribs, valAttribs =
+        // Do not rotate if some attrs fail to typecheck...
+        if List.length attribs <> attrs.Length then [], [], attribs
+        else attribs
+             |> List.zip attrs
+             |> List.partition(function | _, Attrib(_, _, _, _, _, Some ts, _) -> ts &&& AttributeTargets.ReturnValue <> enum 0 | _ -> false)
+             |> fun (r, v) -> (List.map fst r, List.map snd r, List.map snd v)
+    let retAttribs =
+        match rtyOpt with
+        | Some (SynBindingReturnInfo(attributes = Attributes retAttrs)) ->
+            rotRetAttribs @ TcAttrs cenv env attrTgt AttributeTargets.ReturnValue true retAttrs
+        | None -> rotRetAttribs
+    let valSynData =
+        match rotRetSynAttrs with
+        | [] -> valSynData
+        | {Range=mHead} :: _ ->
+        let (SynValData(valMf, SynValInfo(args, SynArgInfo(attrs, opt, retId)), valId)) = valSynData
+        SynValData(valMf, SynValInfo(args, SynArgInfo({Attributes=rotRetSynAttrs; Range=mHead} :: attrs, opt, retId)), valId)
+    retAttribs, valAttribs, valSynData
+
 // Note:
 // - Let bound values can only have attributes that uses AttributeTargets.Field ||| AttributeTargets.Property ||| AttributeTargets.ReturnValue
 // - Let function bindings can only have attributes that uses AttributeTargets.Method ||| AttributeTargets.ReturnValue
@@ -11547,6 +11539,17 @@ and TcAttributesCanFail cenv env attrTgt synAttribs =
 and TcAttributes cenv env attrTgt synAttribs =
     TcAttributesMaybeFail TcCanFail.ReportAllErrors cenv env attrTgt synAttribs |> fst
 
+// Check the attributes of the binding, parameters or return value
+and TcAttrs cenv env attrTgt tgt isRet attrs =
+    // For all but attributes positioned at the return value, disallow implicitly
+    // targeting the return value.
+    let tgtEx = if isRet then enum 0 else AttributeTargets.ReturnValue
+    let attrs, _ = TcAttributesMaybeFailEx TcCanFail.ReportAllErrors cenv env tgt tgtEx attrs
+    if attrTgt = enum 0 && not (isNil attrs) then
+        for attr in attrs do
+            errorR(Error(FSComp.SR.tcAttributesAreNotPermittedOnLetBindings(), attr.Range))
+    attrs
+
 //-------------------------------------------------------------------------
 // TcLetBinding
 //------------------------------------------------------------------------
@@ -12246,14 +12249,18 @@ and AnalyzeAndMakeAndPublishRecursiveValue
 
     // Pull apart the inputs
     let (NormalizedBinding(vis1, bindingKind, isInline, isMutable, bindingSynAttribs, bindingXmlDoc, synTyparDecls, valSynData, declPattern, bindingRhs, mBinding, debugPoint)) = binding
-    let (NormalizedBindingRhs(_, _, bindingExpr)) = bindingRhs
-    let (SynValData(memberFlagsOpt, valSynInfo, thisIdOpt)) = valSynData
+    let (NormalizedBindingRhs(_, rtyOpt, bindingExpr)) = bindingRhs
+    let (SynValData(memberFlagsOpt, _, thisIdOpt)) = valSynData
     let (ContainerInfo(altActualParent, tcrefContainerInfo)) = containerInfo
 
     let attrTgt = declKind.AllowedAttribTargets memberFlagsOpt
 
     // Check the attributes on the declaration
-    let bindingAttribs = TcAttributes cenv env attrTgt bindingSynAttribs
+    let retAttribs, bindingAttribs, (SynValData(_, valSynInfo, _) as valSynData) = TcNormalizeReturnAttribs cenv env attrTgt bindingSynAttribs valSynData rtyOpt
+
+    // Add the return attributes back onto the binding attributes so that ActivePatternElemsOfValRef will see
+    // `[<return: Struct>]` as ValRef does not contain return attributes.
+    let bindingAttribs = retAttribs @ bindingAttribs
 
     // Allocate the type inference variable for the inferred type
     let ty = NewInferenceType g

src/Compiler/CodeGen/IlxGen.fs

@@ -9360,6 +9360,12 @@ and GenMethodForBinding
                 g.DebuggerNonUserCodeAttribute
         ]
 
+    // Remove attributes that are applied to the return.  These attributes need to be passed through ValRef.Attribs so that
+    // ActivePatternElemsOfValRef will correctly propagate `[<return: Struct>]` on active patterns.
+    let attrs =
+        attrs
+        |> List.filter (function Attrib(targetsOpt = Some flags) -> not (flags.HasFlag(AttributeTargets.ReturnValue)) | _ -> true)
+
     let ilAttrsThatGoOnPrimaryItem =
         [
             yield! GenAttrs cenv eenv attrs

tests/FSharp.Compiler.ComponentTests/EmittedIL/Misc/Misc.fs

@@ -1,7 +1,6 @@
 namespace EmittedIL.RealInternalSignature
 
 open Xunit
-open System.IO
 open FSharp.Test
 open FSharp.Test.Compiler
 
@@ -218,3 +217,10 @@ module Misc =
         |> getCompilation
         |> asExe
         |> verifyCompilation
+
+    [<Theory; FileInlineData("ReturnAttributeOnClassMethod.fs")>]
+    let ``ReturnAttributeOnClassMethod_fs`` compilation =
+        compilation
+        |> getCompilation
+        |> asExe
+        |> verifyCompilation

tests/FSharp.Compiler.ComponentTests/EmittedIL/Misc/ReturnAttributeOnClassMethod.fs

@@ -0,0 +1,5 @@
+open System.Diagnostics.CodeAnalysis
+
+type Class() =
+    [<return: NotNull>]
+    static member ClassMethod () = obj()

tests/FSharp.Compiler.ComponentTests/EmittedIL/Misc/ReturnAttributeOnClassMethod.fs.il.bsl

@@ -0,0 +1,81 @@
+
+
+
+
+
+.assembly extern runtime { }
+.assembly extern FSharp.Core { }
+.assembly assembly
+{
+  .custom instance void [FSharp.Core]Microsoft.FSharp.Core.FSharpInterfaceDataVersionAttribute::.ctor(int32,
+                                                                                                      int32,
+                                                                                                      int32) = ( 01 00 02 00 00 00 00 00 00 00 00 00 00 00 00 00 ) 
+
+  
+  
+
+  .hash algorithm 0x00008004
+  .ver 0:0:0:0
+}
+.module assembly.exe
+
+.imagebase {value}
+.file alignment 0x00000200
+.stackreserve 0x00100000
+.subsystem 0x0003       
+.corflags 0x00000001    
+
+
+
+
+
+.class public abstract auto ansi sealed assembly
+       extends [runtime]System.Object
+{
+  .custom instance void [FSharp.Core]Microsoft.FSharp.Core.CompilationMappingAttribute::.ctor(valuetype [FSharp.Core]Microsoft.FSharp.Core.SourceConstructFlags) = ( 01 00 07 00 00 00 00 00 ) 
+  .class auto ansi serializable nested public Class
+         extends [runtime]System.Object
+  {
+    .custom instance void [FSharp.Core]Microsoft.FSharp.Core.CompilationMappingAttribute::.ctor(valuetype [FSharp.Core]Microsoft.FSharp.Core.SourceConstructFlags) = ( 01 00 03 00 00 00 00 00 ) 
+    .method public specialname rtspecialname instance void  .ctor() cil managed
+    {
+      
+      .maxstack  8
+      IL_0000:  ldarg.0
+      IL_0001:  callvirt   instance void [runtime]System.Object::.ctor()
+      IL_0006:  ldarg.0
+      IL_0007:  pop
+      IL_0008:  ret
+    } 
+
+    .method public static object  ClassMethod() cil managed
+    {
+      .param [0]
+      .custom instance void [runtime]System.Diagnostics.CodeAnalysis.NotNullAttribute::.ctor() = ( 01 00 00 00 ) 
+      
+      .maxstack  8
+      IL_0000:  newobj     instance void [runtime]System.Object::.ctor()
+      IL_0005:  ret
+    } 
+
+  } 
+
+} 
+
+.class private abstract auto ansi sealed '<StartupCode$assembly>'.$assembly
+       extends [runtime]System.Object
+{
+  .method public static void  main@() cil managed
+  {
+    .entrypoint
+    
+    .maxstack  8
+    IL_0000:  ret
+  } 
+
+} 
+
+
+
+
+