Enforce union case declarations AttributeTargets

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

@@ -14,6 +14,7 @@
 * Allow calling method with both Optional and ParamArray. ([#PR 16688](https://github.com/dotnet/fsharp/pull/16688), [suggestions #1120](https://github.com/fsharp/fslang-suggestions/issues/1120))
 * Fix release inline optimization, which leads to MethodAccessException if used with `assembly:InternalsVisibleTo`` attribute. ([Issue #16105](https://github.com/dotnet/fsharp/issues/16105), ([PR #16737](https://github.com/dotnet/fsharp/pull/16737))
 * Enforce AttributeTargets on let values and functions. ([PR #16692](https://github.com/dotnet/fsharp/pull/16692))
+* Enforce AttributeTargets on union case declarations. ([PR #16764](https://github.com/dotnet/fsharp/pull/16764))
 
 ### Added
 

docs/release-notes/.Language/preview.md

@@ -9,6 +9,7 @@
 
 * Allow extension methods without type attribute work for types from imported assemblies. ([PR #16368](https://github.com/dotnet/fsharp/pull/16368))
 * Enforce AttributeTargets on let values and functions. ([PR #16692](https://github.com/dotnet/fsharp/pull/16692))
+* Enforce AttributeTargets on union case declarations. ([PR #16764](https://github.com/dotnet/fsharp/pull/16764))
 
 ### Changed
 

src/Compiler/Checking/CheckDeclarations.fs

@@ -511,7 +511,14 @@ module TcRecdUnionAndEnumDeclarations =
 
     let TcUnionCaseDecl (cenv: cenv) env parent thisTy thisTyInst tpenv hasRQAAttribute (SynUnionCase(Attributes synAttrs, SynIdent(id, _), args, xmldoc, vis, m, _)) =
         let g = cenv.g
-        let attrs = TcAttributes cenv env AttributeTargets.UnionCaseDecl synAttrs // the attributes of a union case decl get attached to the generated "static factory" method
+        let attrs =
+            // The attributes of a union case decl get attached to the generated "static factory" method
+            // Enforce that the union-cases can only be targeted by attributes with AttributeTargets.Method
+            if g.langVersion.SupportsFeature(LanguageFeature.EnforceAttributeTargetsUnionCaseDeclarations) then
+                TcAttributes cenv env AttributeTargets.Method synAttrs
+            else
+                TcAttributes cenv env AttributeTargets.UnionCaseDecl synAttrs
+
         let vis, _ = ComputeAccessAndCompPath env None m vis None parent
         let vis = CombineReprAccess parent vis
 

src/Compiler/Checking/CheckExpressions.fs

@@ -10874,17 +10874,23 @@ and TcNormalizedBinding declKind (cenv: cenv) env tpenv overallTy safeThisValOpt
                 errorR(Error(FSComp.SR.tcLiteralCannotHaveGenericParameters(), mBinding))
 
         if g.langVersion.SupportsFeature(LanguageFeature.EnforceAttributeTargetsOnFunctions) && memberFlagsOpt.IsNone && not attrs.IsEmpty then
-            let rhsIsFunction = isFunTy g overallPatTy
-            let lhsIsFunction = isFunTy g overallExprTy
-            let attrTgt =
-                match rhsIsFunction, lhsIsFunction with
-                | false, false when declaredTypars.IsEmpty -> AttributeTargets.Field ||| AttributeTargets.Property ||| AttributeTargets.ReturnValue
-                | _, _ -> AttributeTargets.Method ||| AttributeTargets.ReturnValue
-
-            TcAttributesWithPossibleTargets false cenv env attrTgt attrs |> ignore
+            TcAttributeTargetsOnLetBindings cenv env attrs overallPatTy overallExprTy (not declaredTypars.IsEmpty)
 
         CheckedBindingInfo(inlineFlag, valAttribs, xmlDoc, tcPatPhase2, explicitTyparInfo, nameToPrelimValSchemeMap, rhsExprChecked, argAndRetAttribs, overallPatTy, mBinding, debugPoint, isCompGen, literalValue, isFixed), tpenv
 
+// 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
+and TcAttributeTargetsOnLetBindings (cenv: cenv) env attrs overallPatTy overallExprTy areTyparsDeclared =
+    let rhsIsFunction = isFunTy cenv.g overallPatTy
+    let lhsIsFunction = isFunTy cenv.g overallExprTy
+    let attrTgt =
+        match rhsIsFunction, lhsIsFunction with
+        | false, false when not areTyparsDeclared -> AttributeTargets.Field ||| AttributeTargets.Property ||| AttributeTargets.ReturnValue
+        | _, _ -> AttributeTargets.Method ||| AttributeTargets.ReturnValue
+
+    TcAttributes cenv env attrTgt attrs |> ignore
+
 and TcLiteral (cenv: cenv) overallTy env tpenv (attrs, synLiteralValExpr) =
 
     let g = cenv.g

src/Compiler/FSComp.txt

@@ -1595,6 +1595,7 @@ featureChkTailCallAttrOnNonRec,"Raises warnings if the 'TailCall' attribute is u
 featureUnionIsPropertiesVisible,"Union case test properties"
 featureBooleanReturningAndReturnTypeDirectedPartialActivePattern,"Boolean-returning and return-type-directed partial active patterns"
 featureEnforceAttributeTargetsOnFunctions,"Enforce AttributeTargets on functions"
+featureEnforceAttributeTargetsUnionCaseDeclarations,"Enforce AttributeTargets on union case declarations"
 featureLowerInterpolatedStringToConcat,"Optimizes interpolated strings in certain cases, by lowering to concatenation"
 3354,tcNotAFunctionButIndexerNamedIndexingNotYetEnabled,"This value supports indexing, e.g. '%s.[index]'. The syntax '%s[index]' requires /langversion:preview. See https://aka.ms/fsharp-index-notation."
 3354,tcNotAFunctionButIndexerIndexingNotYetEnabled,"This expression supports indexing, e.g. 'expr.[index]'. The syntax 'expr[index]' requires /langversion:preview. See https://aka.ms/fsharp-index-notation."

src/Compiler/Facilities/LanguageFeatures.fs

@@ -86,6 +86,7 @@ type LanguageFeature =
     | WarningWhenTailCallAttrOnNonRec
     | BooleanReturningAndReturnTypeDirectedPartialActivePattern
     | EnforceAttributeTargetsOnFunctions
+    | EnforceAttributeTargetsUnionCaseDeclarations
     | LowerInterpolatedStringToConcat
 
 /// LanguageVersion management
@@ -200,6 +201,7 @@ type LanguageVersion(versionText) =
                 LanguageFeature.UnionIsPropertiesVisible, previewVersion
                 LanguageFeature.BooleanReturningAndReturnTypeDirectedPartialActivePattern, previewVersion
                 LanguageFeature.EnforceAttributeTargetsOnFunctions, previewVersion
+                LanguageFeature.EnforceAttributeTargetsUnionCaseDeclarations, previewVersion
                 LanguageFeature.LowerInterpolatedStringToConcat, previewVersion
             ]
 
@@ -345,6 +347,7 @@ type LanguageVersion(versionText) =
         | LanguageFeature.BooleanReturningAndReturnTypeDirectedPartialActivePattern ->
             FSComp.SR.featureBooleanReturningAndReturnTypeDirectedPartialActivePattern ()
         | LanguageFeature.EnforceAttributeTargetsOnFunctions -> FSComp.SR.featureEnforceAttributeTargetsOnFunctions ()
+        | LanguageFeature.EnforceAttributeTargetsUnionCaseDeclarations -> FSComp.SR.featureEnforceAttributeTargetsUnionCaseDeclarations ()
         | LanguageFeature.LowerInterpolatedStringToConcat -> FSComp.SR.featureLowerInterpolatedStringToConcat ()
 
     /// Get a version string associated with the given feature.

src/Compiler/Facilities/LanguageFeatures.fsi

@@ -77,6 +77,7 @@ type LanguageFeature =
     | WarningWhenTailCallAttrOnNonRec
     | BooleanReturningAndReturnTypeDirectedPartialActivePattern
     | EnforceAttributeTargetsOnFunctions
+    | EnforceAttributeTargetsUnionCaseDeclarations
     | LowerInterpolatedStringToConcat
 
 /// LanguageVersion management

tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/CustomAttributes/AttributeUsage/AttributeTargetsIsMethod01.fs

@@ -48,3 +48,10 @@ let test1 =
     |> (=) 6
 
 if not test1 then failwith "Failed: 1"
+
+[<AttributeUsage(AttributeTargets.Method)>]
+type MethodLevelAttribute() =
+    inherit Attribute()
+
+type SomeUnion =
+| [<MethodLevel>] Case1 of int

tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/CustomAttributes/AttributeUsage/AttributeUsage.fs

@@ -64,6 +64,14 @@ module CustomAttributes_AttributeUsage =
         |> verifyCompileAndRun
         |> shouldSucceed
 
+    // SOURCE=AttributeTargetsIsMethod01.fs				# AttributeTargetsIsMethod01.fs
+    [<Theory; Directory(__SOURCE_DIRECTORY__, Includes=[|"AttributeTargetsIsMethod01.fs"|])>]
+    let ``AttributeTargetsIsMethod01_fs preview`` compilation =
+        compilation
+        |> withLangVersionPreview
+        |> verifyCompileAndRun
+        |> shouldSucceed
+
     // SOURCE=ConditionalAttribute.fs					# ConditionalAttribute.fs
     [<Theory; Directory(__SOURCE_DIRECTORY__, Includes=[|"ConditionalAttribute.fs"|])>]
     let ``ConditionalAttribute_fs`` compilation =
@@ -352,5 +360,45 @@ module CustomAttributes_AttributeUsage =
         |> withDiagnostics [
             (Warning 2003, Line 5, Col 59, Line 5, Col 68, "The attribute System.Reflection.AssemblyFileVersionAttribute specified version '9.8.*.6', but this value is invalid and has been ignored")
         ]
-
-
+
+    // SOURCE=E_AttributeTargetIsField03.fs	# E_AttributeTargetIsField03.fs
+    [<Theory; Directory(__SOURCE_DIRECTORY__, Includes=[|"E_AttributeTargetIsField03.fs"|])>]
+    let ``E_AttributeTargetIsField03_fs`` compilation =
+        compilation
+        |> verifyCompile
+        |> shouldFail
+        |> withDiagnostics [
+            (Error 842, Line 14, Col 5, Line 14, Col 15, "This attribute is not valid for use on this language element")
+        ]
+
+    // SOURCE=E_AttributeTargetIsField03.fs	# E_AttributeTargetIsField03.fs
+    [<Theory; Directory(__SOURCE_DIRECTORY__, Includes=[|"E_AttributeTargetIsField03.fs"|])>]
+    let ``E_AttributeTargetIsField03_fs preview`` compilation =
+        compilation
+        |> withLangVersionPreview
+        |> verifyCompile
+        |> shouldFail
+        |> withDiagnostics [
+            (Error 842, Line 14, Col 5, Line 14, Col 15, "This attribute is not valid for use on this language element")
+            (Error 842, Line 15, Col 5, Line 15, Col 25, "This attribute is not valid for use on this language element")
+        ]
+
+
+    // SOURCE=E_AttributeTargetIsProperty01.fs	# E_AttributeTargetIsField03.fs
+    [<Theory; Directory(__SOURCE_DIRECTORY__, Includes=[|"E_AttributeTargetIsProperty01.fs"|])>]
+    let ``E_AttributeTargetIsProperty01_fs`` compilation =
+        compilation
+        |> verifyCompile
+        |> shouldSucceed
+
+    // SOURCE=E_AttributeTargetIsProperty01.fs	# E_AttributeTargetIsField03.fs
+    [<Theory; Directory(__SOURCE_DIRECTORY__, Includes=[|"E_AttributeTargetIsProperty01.fs"|])>]
+    let ``E_AttributeTargetIsProperty01_fs preview`` compilation =
+        compilation
+        |> withLangVersionPreview
+        |> verifyCompile
+        |> shouldFail
+        |> withDiagnostics [
+            (Error 842, Line 14, Col 5, Line 14, Col 18, "This attribute is not valid for use on this language element")
+            (Error 842, Line 15, Col 5, Line 15, Col 25, "This attribute is not valid for use on this language element")
+        ]

tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/CustomAttributes/AttributeUsage/E_AttributeTargetIsField03.fs

@@ -0,0 +1,16 @@
+// This tests that AttributeTargets.Field  is not allowed in union-case declaration
+
+open System
+
+[<AttributeUsage(AttributeTargets.Field)>]
+type FieldLevelAttribute() =
+    inherit Attribute()
+
+[<AttributeUsage(AttributeTargets.Property ||| AttributeTargets.Field)>]
+type PropertyOrFieldLevelAttribute() =
+    inherit Attribute()
+
+type SomeUnion =
+| [<FieldLevel>] Case1 of int  // Should fail
+| [<PropertyOrFieldLevel>] Case2 of int  // Should fail
+

tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/CustomAttributes/AttributeUsage/E_AttributeTargetIsProperty01.fs

@@ -0,0 +1,15 @@
+// This tests that AttributeTargets.Property  is not allowed in union-case declaration
+
+open System
+
+[<AttributeUsage(AttributeTargets.Property)>]
+type PropertyLevelAttribute() =
+    inherit Attribute()
+
+[<AttributeUsage(AttributeTargets.Property ||| AttributeTargets.Field)>]
+type PropertyOrFieldLevelAttribute() =
+    inherit Attribute()
+
+type SomeUnion =
+| [<PropertyLevel>] Case1 of int // Should fail
+| [<PropertyOrFieldLevel>] Case2 of int // Should fail