opt-in warning attribute not valid for union case with fields

src/Compiler/Checking/CheckDeclarations.fs

@@ -577,22 +577,33 @@ module TcRecdUnionAndEnumDeclarations =
 
         let checkXmlDocs = cenv.diagnosticOptions.CheckXmlDocs
         let xmlDoc = xmldoc.ToXmlDoc(checkXmlDocs, Some names)
-        let attrs =
-            (*
-                The attributes of a union case decl get attached to the generated "static factory" method.
-                Enforce union-cases AttributeTargets:
-                - AttributeTargets.Method
-                    type SomeUnion =
-                    | Case1 of int // Compiles down to a static method
-                - AttributeTargets.Property
-                    type SomeUnion =
-                    | Case1 // Compiles down to a static property
-            *)
-            if g.langVersion.SupportsFeature(LanguageFeature.EnforceAttributeTargets) then
-                let target = if rfields.IsEmpty then AttributeTargets.Property else AttributeTargets.Method
-                TcAttributes cenv env target synAttrs
-            else
-                TcAttributes cenv env AttributeTargets.UnionCaseDecl synAttrs
+        let attrs = TcAttributes cenv env AttributeTargets.UnionCaseDecl synAttrs
+        (*
+            The attributes of a union case decl get attached to the generated "static factory" method.
+            Enforce union-cases AttributeTargets:
+            - AttributeTargets.Method
+                type SomeUnion =
+                | Case1 of int // Compiles down to a static method
+            - AttributeTargets.Property
+                type SomeUnion =
+                | Case1 // Compiles down to a static property
+        *)
+        if g.langVersion.SupportsFeature(LanguageFeature.EnforceAttributeTargets) then
+            let attrTargets =
+                attrs
+                |> List.collect (fun attr ->
+                    attr.TyconRef.Attribs
+                    |> List.choose (fun attr ->
+                        match attr with
+                        | Attrib(unnamedArgs = [ AttribInt32Arg validOn ]) -> Some validOn
+                        | _ -> None))
+
+            attrTargets
+            |> List.iter (fun target ->
+                // If the union case has fields, and the target is not AttributeTargets.Method || AttributeTargets.All. Then we raise a separate opt-in warning
+                let targetEnum = enum<AttributeTargets> target
+                if targetEnum <> AttributeTargets.Method && targetEnum <> AttributeTargets.All then
+                    warning(Error(FSComp.SR.tcAttributeIsNotValidForUnionCaseWithFields(), id.idRange)))
 
         Construct.NewUnionCase id rfields recordTy attrs xmlDoc vis
 

src/Compiler/Driver/CompilerDiagnostics.fs

@@ -402,6 +402,7 @@ type PhasedDiagnostic with
         | 3579 -> false // alwaysUseTypedStringInterpolation - off by default
         | 3582 -> false // infoIfFunctionShadowsUnionCase - off by default
         | 3570 -> false // tcAmbiguousDiscardDotLambda - off by default
+        | 3875 -> false // tcAttributeIsNotValidForUnionCaseWithFields - off by default
         | _ ->
             match x.Exception with
             | DiagnosticEnabledWithLanguageFeature(_, _, _, enabled) -> enabled

src/Compiler/FSComp.txt

@@ -1795,6 +1795,7 @@ featureUseTypeSubsumptionCache,"Use type conversion cache during compilation"
 featureDontWarnOnUppercaseIdentifiersInBindingPatterns,"Don't warn on uppercase identifiers in binding patterns"
 3873,chkDeprecatePlacesWhereSeqCanBeOmitted,"This construct is deprecated. Sequence expressions should be of the form 'seq {{ ... }}'"
 3874,tcExpectedTypeParamMarkedWithUnitOfMeasureAttribute,"Expected unit-of-measure type parameter must be marked with the [<Measure>] attribute."
+3875,tcAttributeIsNotValidForUnionCaseWithFields,"This attribute is not valid for use on union cases with fields."
 featureDeprecatePlacesWhereSeqCanBeOmitted,"Deprecate places where 'seq' can be omitted"
 featureSupportValueOptionsAsOptionalParameters,"Support ValueOption as valid type for optional member parameters"
 featureSupportWarnWhenUnitPassedToObjArg,"Warn when unit is passed to a member accepting `obj` argument, e.g. `Method(o:obj)` will warn if called via `Method()`."

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

@@ -492,7 +492,6 @@ module CustomAttributes_AttributeUsage =
         |> 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
@@ -509,11 +508,7 @@ module CustomAttributes_AttributeUsage =
         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")
-        ]
+        |> shouldSucceed
 
     // SOURCE=E_AttributeTargetIsCtor01.fs	# E_AttributeTargetIsCtor01.fs
     [<Theory; Directory(__SOURCE_DIRECTORY__, Includes=[|"E_AttributeTargetIsCtor01.fs"|])>]