Account for CLIMutableAttribute when checking attribute targets

src/Compiler/Checking/CheckDeclarations.fs

@@ -2854,12 +2854,19 @@ module EstablishTypeDefinitionCores =
         let attrs, getFinalAttrs = TcAttributesCanFail cenv envinner AttributeTargets.TyconDecl synAttrs
         let hasMeasureAttr = HasFSharpAttribute g g.attrib_MeasureAttribute attrs
         let hasStructAttr = HasFSharpAttribute g g.attrib_StructAttribute attrs
+        let hasCLIMutable = HasFSharpAttribute g g.attrib_CLIMutableAttribute attrs
+        // CLIMutableAttribute has a special treatment(specific error FS3132) in the case of records(Only record types may have this attribute.)
+        // So we want to keep these special treatment for records and avoid having two errors for the same attribute.
+        let reportAttributeTargetsErrors = g.langVersion.SupportsFeature(LanguageFeature.EnforceAttributeTargets) && not hasCLIMutable
+
+        let noCLIMutableAttributeCheck() =
+            if hasCLIMutable then errorR (Error(FSComp.SR.tcThisTypeMayNotHaveACLIMutableAttribute(), m))
 
         let isStructRecordOrUnionType = 
             match synTyconRepr with
             | SynTypeDefnSimpleRepr.Record _ 
             | TyconCoreAbbrevThatIsReallyAUnion (hasMeasureAttr, envinner, id) _
-            | SynTypeDefnSimpleRepr.Union _ -> 
+            | SynTypeDefnSimpleRepr.Union _ ->
                 HasFSharpAttribute g g.attrib_StructAttribute attrs
             | _ -> 
                 false
@@ -2888,11 +2895,11 @@ module EstablishTypeDefinitionCores =
 
             | TyconCoreAbbrevThatIsReallyAUnion (hasMeasureAttr, envinner, id) (_, m)
             | SynTypeDefnSimpleRepr.Union (_, _, m) -> 
-
+                noCLIMutableAttributeCheck()
                 // Run InferTyconKind to raise errors on inconsistent attribute sets
                 InferTyconKind g (SynTypeDefnKind.Union, attrs, [], [], inSig, true, m) |> ignore
 
-                if g.langVersion.SupportsFeature(LanguageFeature.EnforceAttributeTargets) then
+                if reportAttributeTargetsErrors then
                     if hasStructAttr then
                         TcAttributesWithPossibleTargets false cenv envinner AttributeTargets.Struct synAttrs |> ignore
                     else
@@ -2908,16 +2915,16 @@ module EstablishTypeDefinitionCores =
 
             | SynTypeDefnSimpleRepr.LibraryOnlyILAssembly (s, m) -> 
                 let s = (s :?> ILType)
+                noCLIMutableAttributeCheck()
                 // Run InferTyconKind to raise errors on inconsistent attribute sets
                 InferTyconKind g (SynTypeDefnKind.IL, attrs, [], [], inSig, true, m) |> ignore
                 TAsmRepr s
 
             | SynTypeDefnSimpleRepr.Record (_, _, m) -> 
-
                 // Run InferTyconKind to raise errors on inconsistent attribute sets
                 InferTyconKind g (SynTypeDefnKind.Record, attrs, [], [], inSig, true, m) |> ignore
 
-                if g.langVersion.SupportsFeature(LanguageFeature.EnforceAttributeTargets) then
+                if reportAttributeTargetsErrors then
                     if hasStructAttr then
                         TcAttributesWithPossibleTargets false cenv envinner AttributeTargets.Struct synAttrs |> ignore
                     else
@@ -2928,34 +2935,36 @@ module EstablishTypeDefinitionCores =
 
             | SynTypeDefnSimpleRepr.General (kind, _, slotsigs, fields, isConcrete, _, _, _) ->
                 let kind = InferTyconKind g (kind, attrs, slotsigs, fields, inSig, isConcrete, m)
+                noCLIMutableAttributeCheck()
                 match kind with 
                 | SynTypeDefnKind.Opaque -> 
                     TNoRepr
                 | _ -> 
                     let kind = 
                         match kind with
                         | SynTypeDefnKind.Class ->
-                            if g.langVersion.SupportsFeature(LanguageFeature.EnforceAttributeTargets) then
+                            if reportAttributeTargetsErrors then
                                 TcAttributesWithPossibleTargets false cenv envinner AttributeTargets.Class synAttrs |> ignore
                             TFSharpClass
                         | SynTypeDefnKind.Interface ->
-                            if g.langVersion.SupportsFeature(LanguageFeature.EnforceAttributeTargets) then
+                            if reportAttributeTargetsErrors then
                                 TcAttributesWithPossibleTargets false cenv envinner AttributeTargets.Interface synAttrs |> ignore
                             TFSharpInterface
                         | SynTypeDefnKind.Delegate _ ->
-                            if g.langVersion.SupportsFeature(LanguageFeature.EnforceAttributeTargets) then
+                            if reportAttributeTargetsErrors then
                                 TcAttributesWithPossibleTargets false cenv envinner AttributeTargets.Delegate synAttrs |> ignore
                             TFSharpDelegate (MakeSlotSig("Invoke", g.unit_ty, [], [], [], None))
                         | SynTypeDefnKind.Struct ->
-                            if g.langVersion.SupportsFeature(LanguageFeature.EnforceAttributeTargets) then
+                            if reportAttributeTargetsErrors then
                                 TcAttributesWithPossibleTargets false cenv envinner AttributeTargets.Struct synAttrs |> ignore
                             TFSharpStruct 
                         | _ -> error(InternalError("should have inferred tycon kind", m))
 
                     TFSharpTyconRepr (Construct.NewEmptyFSharpTyconData kind)
 
             | SynTypeDefnSimpleRepr.Enum _ ->
-                if g.langVersion.SupportsFeature(LanguageFeature.EnforceAttributeTargets) then
+                noCLIMutableAttributeCheck()
+                if reportAttributeTargetsErrors then
                     TcAttributesWithPossibleTargets false cenv envinner AttributeTargets.Enum synAttrs |> ignore
                 TFSharpTyconRepr (Construct.NewEmptyFSharpTyconData TFSharpEnum)
 
@@ -3368,7 +3377,6 @@ module EstablishTypeDefinitionCores =
             // REVIEW: for hasMeasureableAttr we need to be stricter about checking these
             // are only used on exactly the right kinds of type definitions and not in conjunction with other attributes.
             let hasMeasureableAttr = HasFSharpAttribute g g.attrib_MeasureableAttribute attrs
-            let hasCLIMutable = HasFSharpAttribute g g.attrib_CLIMutableAttribute attrs
 
             let structLayoutAttr = TryFindFSharpInt32Attribute g g.attrib_StructLayoutAttribute attrs
             let hasAllowNullLiteralAttr = TryFindFSharpBoolAttribute g g.attrib_AllowNullLiteralAttribute attrs = Some true
@@ -3412,9 +3420,6 @@ module EstablishTypeDefinitionCores =
             let noMeasureAttributeCheck() = 
                 if hasMeasureAttr then errorR (Error(FSComp.SR.tcOnlyTypesRepresentingUnitsOfMeasureCanHaveMeasure(), m))
 
-            let noCLIMutableAttributeCheck() = 
-                if hasCLIMutable then errorR (Error(FSComp.SR.tcThisTypeMayNotHaveACLIMutableAttribute(), m))
-
             let noSealedAttributeCheck k = 
                 if hasSealedAttr = Some true then errorR (Error(k(), m))
 
@@ -3528,7 +3533,6 @@ module EstablishTypeDefinitionCores =
                         TNoRepr, None, NoSafeInitInfo
 
                 | SynTypeDefnSimpleRepr.Union (_, unionCases, mRepr) -> 
-                    noCLIMutableAttributeCheck()
                     noMeasureAttributeCheck()
                     noSealedAttributeCheck FSComp.SR.tcTypesAreAlwaysSealedDU
                     noAbstractClassAttributeCheck()
@@ -3568,7 +3572,6 @@ module EstablishTypeDefinitionCores =
 
                 | SynTypeDefnSimpleRepr.LibraryOnlyILAssembly (s, _) -> 
                     let s = (s :?> ILType)
-                    noCLIMutableAttributeCheck()
                     noMeasureAttributeCheck()
                     noSealedAttributeCheck FSComp.SR.tcTypesAreAlwaysSealedAssemblyCode
                     noAllowNullLiteralAttributeCheck()
@@ -3634,7 +3637,6 @@ module EstablishTypeDefinitionCores =
                         let kind = 
                             match kind with 
                               | SynTypeDefnKind.Struct -> 
-                                  noCLIMutableAttributeCheck()
                                   noSealedAttributeCheck FSComp.SR.tcTypesAreAlwaysSealedStruct
                                   noAbstractClassAttributeCheck()
                                   noAllowNullLiteralAttributeCheck()
@@ -3645,22 +3647,19 @@ module EstablishTypeDefinitionCores =
                                   TFSharpStruct
                               | SynTypeDefnKind.Interface -> 
                                   if hasSealedAttr = Some true then errorR (Error(FSComp.SR.tcInterfaceTypesCannotBeSealed(), m))
-                                  noCLIMutableAttributeCheck()
                                   structLayoutAttributeCheck false
                                   noAbstractClassAttributeCheck()
                                   allowNullLiteralAttributeCheck()
                                   noFieldsCheck userFields
                                   TFSharpInterface
                               | SynTypeDefnKind.Class -> 
-                                  noCLIMutableAttributeCheck()
                                   structLayoutAttributeCheck(not isIncrClass)
                                   allowNullLiteralAttributeCheck()
                                   for slot in abstractSlots do
                                       if not slot.IsInstanceMember then
                                           errorR(Error(FSComp.SR.chkStaticAbstractMembersOnClasses(), slot.Range))
                                   TFSharpClass
                               | SynTypeDefnKind.Delegate (ty, arity) -> 
-                                  noCLIMutableAttributeCheck()
                                   noSealedAttributeCheck FSComp.SR.tcTypesAreAlwaysSealedDelegate
                                   structLayoutAttributeCheck false
                                   noAllowNullLiteralAttributeCheck()
@@ -3711,7 +3710,6 @@ module EstablishTypeDefinitionCores =
                     let fieldTy, fields' = TcRecdUnionAndEnumDeclarations.TcEnumDecls cenv envinner tpenv innerParent thisTy decls
                     let kind = TFSharpEnum
                     structLayoutAttributeCheck false
-                    noCLIMutableAttributeCheck()
                     noSealedAttributeCheck FSComp.SR.tcTypesAreAlwaysSealedEnum
                     noAllowNullLiteralAttributeCheck()
                     let vid = ident("value__", m)

src/FSharp.Core/prim-types.fs

@@ -101,7 +101,7 @@ namespace Microsoft.FSharp.Core
     type CLIEventAttribute() = 
         inherit Attribute()
 
-    [<AttributeUsage (AttributeTargets.Class, AllowMultiple=false)>]  
+    [<AttributeUsage (AttributeTargets.Class ||| AttributeTargets.Struct, AllowMultiple=false)>]  
     [<Sealed>]
     type CLIMutableAttribute() = 
         inherit Attribute()

src/FSharp.Core/prim-types.fsi

@@ -310,7 +310,7 @@ namespace Microsoft.FSharp.Core
     /// with a default constructor with property getters and setters.</summary>
     ///
     /// <category>Attributes</category>
-    [<AttributeUsage (AttributeTargets.Class,AllowMultiple=false)>]  
+    [<AttributeUsage (AttributeTargets.Class ||| AttributeTargets.Struct,AllowMultiple=false)>]  
     [<Sealed>]
     type CLIMutableAttribute =
         inherit Attribute

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

@@ -686,4 +686,56 @@ type InterruptibleLazy<'T> private (valueFactory: unit -> 'T) =
             (Error 842, Line 44, Col 3, Line 44, Col 15, "This attribute is not valid for use on this language element")
             (Error 842, Line 47, Col 3, Line 47, Col 14, "This attribute is not valid for use on this language element")
             (Error 842, Line 48, Col 3, Line 48, Col 18, "This attribute is not valid for use on this language element")
+        ]
+
+    // SOURCE= CLIMutableAttribute01.fs	# CLIMutableAttribute01.fs
+    [<Theory; Directory(__SOURCE_DIRECTORY__, Includes=[|"CLIMutableAttribute01.fs"|])>]
+    let ``CLIMutableAttribute01 8.0`` compilation =
+        compilation
+        |> withLangVersion80
+        |> verifyCompile
+        |> shouldSucceed
+
+    // SOURCE=CLIMutableAttribute01.fs	# CLIMutableAttribute01.fs
+    [<Theory; Directory(__SOURCE_DIRECTORY__, Includes=[|"CLIMutableAttribute01.fs"|])>]
+    let ``CLIMutableAttribute01 preview`` compilation =
+        compilation
+        |> withLangVersionPreview
+        |> verifyCompile
+        |> shouldSucceed
+
+    // SOURCE= E_CLIMutableAttribute.fs	# E_CLIMutableAttribute.fs
+    [<Theory; Directory(__SOURCE_DIRECTORY__, Includes=[|"E_CLIMutableAttribute.fs"|])>]
+    let ``E_CLIMutableAttribute 8.0`` compilation =
+        compilation
+        |> withLangVersion80
+        |> verifyCompile
+        |> shouldFail
+        |> withDiagnostics [
+            (Error 3132, Line 4, Col 8, Line 4, Col 16, "This type definition may not have the 'CLIMutable' attribute. Only record types may have this attribute.")
+            (Error 3132, Line 7, Col 8, Line 7, Col 16, "This type definition may not have the 'CLIMutable' attribute. Only record types may have this attribute.")
+            (Error 3132, Line 10, Col 8, Line 10, Col 20, "This type definition may not have the 'CLIMutable' attribute. Only record types may have this attribute.")
+            (Error 3132, Line 13, Col 8, Line 13, Col 17, "This type definition may not have the 'CLIMutable' attribute. Only record types may have this attribute.")
+            (Error 3132, Line 16, Col 8, Line 16, Col 15, "This type definition may not have the 'CLIMutable' attribute. Only record types may have this attribute.")
+            (Error 3132, Line 19, Col 8, Line 19, Col 19, "This type definition may not have the 'CLIMutable' attribute. Only record types may have this attribute.")
+            (Error 3132, Line 22, Col 8, Line 22, Col 17, "This type definition may not have the 'CLIMutable' attribute. Only record types may have this attribute.")
+            (Error 3132, Line 25, Col 8, Line 25, Col 18, "This type definition may not have the 'CLIMutable' attribute. Only record types may have this attribute.")
+        ]
+
+    // SOURCE=E_CLIMutableAttribute.fs	# E_CLIMutableAttribute.fs
+    [<Theory; Directory(__SOURCE_DIRECTORY__, Includes=[|"E_CLIMutableAttribute.fs"|])>]
+    let ``E_CLIMutableAttribute preview`` compilation =
+        compilation
+        |> withLangVersionPreview
+        |> verifyCompile
+        |> shouldFail
+        |> withDiagnostics [
+            (Error 3132, Line 4, Col 8, Line 4, Col 16, "This type definition may not have the 'CLIMutable' attribute. Only record types may have this attribute.")
+            (Error 3132, Line 7, Col 8, Line 7, Col 16, "This type definition may not have the 'CLIMutable' attribute. Only record types may have this attribute.")
+            (Error 3132, Line 10, Col 8, Line 10, Col 20, "This type definition may not have the 'CLIMutable' attribute. Only record types may have this attribute.")
+            (Error 3132, Line 13, Col 8, Line 13, Col 17, "This type definition may not have the 'CLIMutable' attribute. Only record types may have this attribute.")
+            (Error 3132, Line 16, Col 8, Line 16, Col 15, "This type definition may not have the 'CLIMutable' attribute. Only record types may have this attribute.")
+            (Error 3132, Line 19, Col 8, Line 19, Col 19, "This type definition may not have the 'CLIMutable' attribute. Only record types may have this attribute.")
+            (Error 3132, Line 22, Col 8, Line 22, Col 17, "This type definition may not have the 'CLIMutable' attribute. Only record types may have this attribute.")
+            (Error 3132, Line 25, Col 8, Line 25, Col 18, "This type definition may not have the 'CLIMutable' attribute. Only record types may have this attribute.")
         ]

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

@@ -0,0 +1,6 @@
+[<CLIMutable>]
+type Record = { X: int }
+
+[<CLIMutable>]
+[<Struct>]
+type StructRecord = { X: int }

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

@@ -0,0 +1,35 @@
+module BogusUseOfCLIMutable =  begin
+
+  [<CLIMutable>]
+  type BadClass() = member x.P = 1
+
+  [<CLIMutable>]
+  type BadUnion = A | B
+
+  [<CLIMutable>]
+  type BadInterface = interface end
+
+  [<CLIMutable>]
+  type BadClass2 = class end
+
+  [<CLIMutable>]
+  type BadEnum = | A = 1 | B = 2
+
+  [<CLIMutable>]
+  type BadDelegate = delegate of int * int -> int
+
+  [<CLIMutable>]
+  type BadStruct = struct val x : int end
+
+  [<CLIMutable>]
+  type BadStruct2(x:int)  = struct member v.X = x end
+
+  [<CLIMutable>]
+  type Good1 = { x : int; y : int }
+  let good1 = { x = 1; y = 2 }
+
+  [<CLIMutable>]
+  type Good2 = { x : int }
+  let good2 = { x = 1 }
+
+end