diff --git a/FSharp.sln b/FSharp.sln index 83933b62da3..bbda2fe2fa4 100644 --- a/FSharp.sln +++ b/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}" diff --git a/docs/release-notes/.FSharp.Compiler.Service/11.0.0.md b/docs/release-notes/.FSharp.Compiler.Service/11.0.0.md index 655ad02ad2a..cd8d5743784 100644 --- a/docs/release-notes/.FSharp.Compiler.Service/11.0.0.md +++ b/docs/release-notes/.FSharp.Compiler.Service/11.0.0.md @@ -6,6 +6,7 @@ * 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 @@ -13,4 +14,4 @@ * Parallel compilation stabilised and enabled by default ([PR #18998](https://github.com/dotnet/fsharp/pull/18998)) -### Breaking Changes \ No newline at end of file +### Breaking Changes diff --git a/src/Compiler/Checking/Expressions/CheckExpressions.fs b/src/Compiler/Checking/Expressions/CheckExpressions.fs index 5d9197599be..0851b426f0a 100644 --- a/src/Compiler/Checking/Expressions/CheckExpressions.fs +++ b/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 [] 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 [] 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 [] 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 + // `[]` as ValRef does not contain return attributes. + let bindingAttribs = retAttribs @ bindingAttribs // Allocate the type inference variable for the inferred type let ty = NewInferenceType g diff --git a/src/Compiler/CodeGen/IlxGen.fs b/src/Compiler/CodeGen/IlxGen.fs index 7c917fbfa9a..cafb8fe2088 100644 --- a/src/Compiler/CodeGen/IlxGen.fs +++ b/src/Compiler/CodeGen/IlxGen.fs @@ -9360,6 +9360,14 @@ 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 `[]` 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 diff --git a/tests/FSharp.Compiler.ComponentTests/EmittedIL/Misc/Misc.fs b/tests/FSharp.Compiler.ComponentTests/EmittedIL/Misc/Misc.fs index c21c35496f3..c5ee285d626 100644 --- a/tests/FSharp.Compiler.ComponentTests/EmittedIL/Misc/Misc.fs +++ b/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 + + [] + let ``ReturnAttributeOnClassMethod_fs`` compilation = + compilation + |> getCompilation + |> asExe + |> verifyCompilation diff --git a/tests/FSharp.Compiler.ComponentTests/EmittedIL/Misc/ReturnAttributeOnClassMethod.fs b/tests/FSharp.Compiler.ComponentTests/EmittedIL/Misc/ReturnAttributeOnClassMethod.fs new file mode 100644 index 00000000000..f05effd0999 --- /dev/null +++ b/tests/FSharp.Compiler.ComponentTests/EmittedIL/Misc/ReturnAttributeOnClassMethod.fs @@ -0,0 +1,5 @@ +open System.Diagnostics.CodeAnalysis + +type Class() = + [] + static member ClassMethod () = obj() diff --git a/tests/FSharp.Compiler.ComponentTests/EmittedIL/Misc/ReturnAttributeOnClassMethod.fs.il.bsl b/tests/FSharp.Compiler.ComponentTests/EmittedIL/Misc/ReturnAttributeOnClassMethod.fs.il.bsl new file mode 100644 index 00000000000..12357dfe9c7 --- /dev/null +++ b/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 ''.$assembly + extends [runtime]System.Object +{ + .method public static void main@() cil managed + { + .entrypoint + + .maxstack 8 + IL_0000: ret + } + +} + + + + +