From e4728dd5c017e88148b725a400b28de8b7eb8b56 Mon Sep 17 00:00:00 2001 From: Edgar Gonzalez Date: Wed, 21 Aug 2024 17:43:20 +0100 Subject: [PATCH 1/5] Account for AllowNullLiteralAttribute when checking attribute targets --- src/Compiler/Checking/CheckDeclarations.fs | 51 +++++++++--------- .../AttributeUsage/AllowNullLiteral01.fs | 3 ++ .../AttributeUsage/AttributeUsage.fs | 54 ++++++++++++++++++- .../AttributeUsage/E_AllowNullLiteral.fs | 48 +++++++++++++++++ 4 files changed, 130 insertions(+), 26 deletions(-) create mode 100644 tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/CustomAttributes/AttributeUsage/AllowNullLiteral01.fs create mode 100644 tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/CustomAttributes/AttributeUsage/E_AllowNullLiteral.fs diff --git a/src/Compiler/Checking/CheckDeclarations.fs b/src/Compiler/Checking/CheckDeclarations.fs index 347026df9db..ee77bb473a1 100644 --- a/src/Compiler/Checking/CheckDeclarations.fs +++ b/src/Compiler/Checking/CheckDeclarations.fs @@ -2857,10 +2857,21 @@ module EstablishTypeDefinitionCores = 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 hasAllowNullLiteralAttr = HasFSharpAttribute g g.attrib_AllowNullLiteralAttribute attrs + + let reportAttributeTargetsErrors = g.langVersion.SupportsFeature(LanguageFeature.EnforceAttributeTargets) && (not hasCLIMutable || not hasAllowNullLiteralAttr) let noCLIMutableAttributeCheck() = if hasCLIMutable then errorR (Error(FSComp.SR.tcThisTypeMayNotHaveACLIMutableAttribute(), m)) + + let noAllowNullLiteralAttributeCheck() = + if hasAllowNullLiteralAttr then errorR (Error(FSComp.SR.tcRecordsUnionsAbbreviationsStructsMayNotHaveAllowNullLiteralAttribute(), m)) + + let allowNullLiteralAttributeCheck() = + if hasAllowNullLiteralAttr then + tycon.TypeContents.tcaug_super |> Option.iter (fun ty -> if not (TypeNullIsExtraValue g m ty) then errorR (Error(FSComp.SR.tcAllowNullTypesMayOnlyInheritFromAllowNullTypes(), m))) + tycon.ImmediateInterfaceTypesOfFSharpTycon |> List.iter (fun ty -> if not (TypeNullIsExtraValue g m ty) then errorR (Error(FSComp.SR.tcAllowNullTypesMayOnlyInheritFromAllowNullTypes(), m))) let isStructRecordOrUnionType = match synTyconRepr with @@ -2885,6 +2896,7 @@ module EstablishTypeDefinitionCores = | SynTypeDefnSimpleRepr.Exception _ -> TNoRepr | SynTypeDefnSimpleRepr.None m -> // Run InferTyconKind to raise errors on inconsistent attribute sets + noAllowNullLiteralAttributeCheck() InferTyconKind g (SynTypeDefnKind.Opaque, attrs, [], [], inSig, true, m) |> ignore if not inSig && not hasMeasureAttr then errorR(Error(FSComp.SR.tcTypeRequiresDefinition(), m)) @@ -2896,6 +2908,7 @@ module EstablishTypeDefinitionCores = | TyconCoreAbbrevThatIsReallyAUnion (hasMeasureAttr, envinner, id) (_, m) | SynTypeDefnSimpleRepr.Union (_, _, m) -> noCLIMutableAttributeCheck() + noAllowNullLiteralAttributeCheck() // Run InferTyconKind to raise errors on inconsistent attribute sets InferTyconKind g (SynTypeDefnKind.Union, attrs, [], [], inSig, true, m) |> ignore @@ -2910,18 +2923,21 @@ module EstablishTypeDefinitionCores = | SynTypeDefnSimpleRepr.TypeAbbrev _ -> // Run InferTyconKind to raise errors on inconsistent attribute sets + noAllowNullLiteralAttributeCheck() InferTyconKind g (SynTypeDefnKind.Abbrev, attrs, [], [], inSig, true, m) |> ignore TNoRepr | SynTypeDefnSimpleRepr.LibraryOnlyILAssembly (s, m) -> let s = (s :?> ILType) noCLIMutableAttributeCheck() + noAllowNullLiteralAttributeCheck() // 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 + noAllowNullLiteralAttributeCheck() InferTyconKind g (SynTypeDefnKind.Record, attrs, [], [], inSig, true, m) |> ignore if reportAttributeTargetsErrors then @@ -2937,24 +2953,29 @@ module EstablishTypeDefinitionCores = let kind = InferTyconKind g (kind, attrs, slotsigs, fields, inSig, isConcrete, m) noCLIMutableAttributeCheck() match kind with - | SynTypeDefnKind.Opaque -> + | SynTypeDefnKind.Opaque -> + noAllowNullLiteralAttributeCheck() TNoRepr | _ -> let kind = match kind with | SynTypeDefnKind.Class -> + allowNullLiteralAttributeCheck() if reportAttributeTargetsErrors then TcAttributesWithPossibleTargets false cenv envinner AttributeTargets.Class synAttrs |> ignore TFSharpClass | SynTypeDefnKind.Interface -> + allowNullLiteralAttributeCheck() if reportAttributeTargetsErrors then TcAttributesWithPossibleTargets false cenv envinner AttributeTargets.Interface synAttrs |> ignore TFSharpInterface | SynTypeDefnKind.Delegate _ -> + noAllowNullLiteralAttributeCheck() if reportAttributeTargetsErrors then TcAttributesWithPossibleTargets false cenv envinner AttributeTargets.Delegate synAttrs |> ignore TFSharpDelegate (MakeSlotSig("Invoke", g.unit_ty, [], [], [], None)) | SynTypeDefnKind.Struct -> + noAllowNullLiteralAttributeCheck() if reportAttributeTargetsErrors then TcAttributesWithPossibleTargets false cenv envinner AttributeTargets.Struct synAttrs |> ignore TFSharpStruct @@ -2964,6 +2985,8 @@ module EstablishTypeDefinitionCores = | SynTypeDefnSimpleRepr.Enum _ -> noCLIMutableAttributeCheck() + noAllowNullLiteralAttributeCheck() + if reportAttributeTargetsErrors then TcAttributesWithPossibleTargets false cenv envinner AttributeTargets.Enum synAttrs |> ignore TFSharpTyconRepr (Construct.NewEmptyFSharpTyconData TFSharpEnum) @@ -3379,7 +3402,6 @@ module EstablishTypeDefinitionCores = let hasMeasureableAttr = HasFSharpAttribute g g.attrib_MeasureableAttribute attrs let structLayoutAttr = TryFindFSharpInt32Attribute g g.attrib_StructLayoutAttribute attrs - let hasAllowNullLiteralAttr = TryFindFSharpBoolAttribute g g.attrib_AllowNullLiteralAttribute attrs = Some true if hasAbstractAttr then tycon.TypeContents.tcaug_abstract <- true @@ -3387,16 +3409,7 @@ module EstablishTypeDefinitionCores = tycon.entity_attribs <- attrs let noAbstractClassAttributeCheck() = if hasAbstractAttr then errorR (Error(FSComp.SR.tcOnlyClassesCanHaveAbstract(), m)) - - let noAllowNullLiteralAttributeCheck() = - if hasAllowNullLiteralAttr then errorR (Error(FSComp.SR.tcRecordsUnionsAbbreviationsStructsMayNotHaveAllowNullLiteralAttribute(), m)) - - - let allowNullLiteralAttributeCheck() = - if hasAllowNullLiteralAttr then - tycon.TypeContents.tcaug_super |> Option.iter (fun ty -> if not (TypeNullIsExtraValue g m ty) then errorR (Error(FSComp.SR.tcAllowNullTypesMayOnlyInheritFromAllowNullTypes(), m))) - tycon.ImmediateInterfaceTypesOfFSharpTycon |> List.iter (fun ty -> if not (TypeNullIsExtraValue g m ty) then errorR (Error(FSComp.SR.tcAllowNullTypesMayOnlyInheritFromAllowNullTypes(), m))) - + let structLayoutAttributeCheck allowed = let explicitKind = int32 System.Runtime.InteropServices.LayoutKind.Explicit match structLayoutAttr with @@ -3491,7 +3504,6 @@ module EstablishTypeDefinitionCores = | SynTypeDefnSimpleRepr.None _ -> hiddenReprChecks false - noAllowNullLiteralAttributeCheck() if hasMeasureAttr then let repr = TFSharpTyconRepr (Construct.NewEmptyFSharpTyconData TFSharpClass) repr, None, NoSafeInitInfo @@ -3505,7 +3517,6 @@ module EstablishTypeDefinitionCores = | TyconCoreAbbrevThatIsReallyAUnion (hasMeasureAttr, envinner, id) (unionCaseName, _) -> structLayoutAttributeCheck false - noAllowNullLiteralAttributeCheck() let hasRQAAttribute = HasFSharpAttribute cenv.g cenv.g.attrib_RequireQualifiedAccessAttribute tycon.Attribs TcRecdUnionAndEnumDeclarations.CheckUnionCaseName cenv unionCaseName hasRQAAttribute @@ -3520,7 +3531,6 @@ module EstablishTypeDefinitionCores = if hasSealedAttr = Some true then errorR (Error(FSComp.SR.tcAbbreviatedTypesCannotBeSealed(), m)) noAbstractClassAttributeCheck() - noAllowNullLiteralAttributeCheck() if hasMeasureableAttr then let kind = if hasMeasureAttr then TyparKind.Measure else TyparKind.Type let theTypeAbbrev, _ = TcTypeOrMeasureAndRecover (Some kind) cenv NoNewTypars CheckCxs ItemOccurence.UseInType WarnOnIWSAM.No envinner tpenv rhsType @@ -3536,7 +3546,6 @@ module EstablishTypeDefinitionCores = noMeasureAttributeCheck() noSealedAttributeCheck FSComp.SR.tcTypesAreAlwaysSealedDU noAbstractClassAttributeCheck() - noAllowNullLiteralAttributeCheck() structLayoutAttributeCheck false let hasRQAAttribute = HasFSharpAttribute cenv.g cenv.g.attrib_RequireQualifiedAccessAttribute tycon.Attribs @@ -3552,7 +3561,6 @@ module EstablishTypeDefinitionCores = noMeasureAttributeCheck() noSealedAttributeCheck FSComp.SR.tcTypesAreAlwaysSealedRecord noAbstractClassAttributeCheck() - noAllowNullLiteralAttributeCheck() structLayoutAttributeCheck true // these are allowed for records let recdFields = TcRecdUnionAndEnumDeclarations.TcNamedFieldDecls cenv envinner innerParent false tpenv fields recdFields |> CheckDuplicates (fun f -> f.Id) "field" |> ignore @@ -3574,7 +3582,6 @@ module EstablishTypeDefinitionCores = let s = (s :?> ILType) noMeasureAttributeCheck() noSealedAttributeCheck FSComp.SR.tcTypesAreAlwaysSealedAssemblyCode - noAllowNullLiteralAttributeCheck() structLayoutAttributeCheck false noAbstractClassAttributeCheck() TAsmRepr s, None, NoSafeInitInfo @@ -3607,7 +3614,6 @@ module EstablishTypeDefinitionCores = match kind with | SynTypeDefnKind.Opaque -> hiddenReprChecks true - noAllowNullLiteralAttributeCheck() TNoRepr, None, NoSafeInitInfo | _ -> @@ -3639,7 +3645,6 @@ module EstablishTypeDefinitionCores = | SynTypeDefnKind.Struct -> noSealedAttributeCheck FSComp.SR.tcTypesAreAlwaysSealedStruct noAbstractClassAttributeCheck() - noAllowNullLiteralAttributeCheck() if not (isNil slotsigs) then errorR (Error(FSComp.SR.tcStructTypesCannotContainAbstractMembers(), m)) structLayoutAttributeCheck true @@ -3649,12 +3654,10 @@ module EstablishTypeDefinitionCores = if hasSealedAttr = Some true then errorR (Error(FSComp.SR.tcInterfaceTypesCannotBeSealed(), m)) structLayoutAttributeCheck false noAbstractClassAttributeCheck() - allowNullLiteralAttributeCheck() noFieldsCheck userFields TFSharpInterface | SynTypeDefnKind.Class -> structLayoutAttributeCheck(not isIncrClass) - allowNullLiteralAttributeCheck() for slot in abstractSlots do if not slot.IsInstanceMember then errorR(Error(FSComp.SR.chkStaticAbstractMembersOnClasses(), slot.Range)) @@ -3662,7 +3665,6 @@ module EstablishTypeDefinitionCores = | SynTypeDefnKind.Delegate (ty, arity) -> noSealedAttributeCheck FSComp.SR.tcTypesAreAlwaysSealedDelegate structLayoutAttributeCheck false - noAllowNullLiteralAttributeCheck() noAbstractClassAttributeCheck() noFieldsCheck userFields primaryConstructorInDelegateCheck(implicitCtorSynPats) @@ -3711,7 +3713,6 @@ module EstablishTypeDefinitionCores = let kind = TFSharpEnum structLayoutAttributeCheck false noSealedAttributeCheck FSComp.SR.tcTypesAreAlwaysSealedEnum - noAllowNullLiteralAttributeCheck() let vid = ident("value__", m) let vfld = Construct.NewRecdField false None vid false fieldTy false false [] [] XmlDoc.Empty taccessPublic true diff --git a/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/CustomAttributes/AttributeUsage/AllowNullLiteral01.fs b/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/CustomAttributes/AttributeUsage/AllowNullLiteral01.fs new file mode 100644 index 00000000000..a51ad77a443 --- /dev/null +++ b/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/CustomAttributes/AttributeUsage/AllowNullLiteral01.fs @@ -0,0 +1,3 @@ +[] +type D() = + member x.P = 1 \ No newline at end of file diff --git a/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/CustomAttributes/AttributeUsage/AttributeUsage.fs b/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/CustomAttributes/AttributeUsage/AttributeUsage.fs index 68df8538d0c..34c22d6c36a 100644 --- a/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/CustomAttributes/AttributeUsage/AttributeUsage.fs +++ b/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/CustomAttributes/AttributeUsage/AttributeUsage.fs @@ -738,4 +738,56 @@ type InterruptibleLazy<'T> private (valueFactory: unit -> 'T) = (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.") - ] \ No newline at end of file + ] + + // SOURCE= E_AllowNullLiteral.fs # E_AllowNullLiteral.fs + [] + let ``E_AllowNullLiteral 8.0`` compilation = + compilation + |> withLangVersion80 + |> verifyCompile + |> shouldFail + |> withDiagnostics [ + (Error 935, Line 15, Col 10, Line 15, Col 11, "Types with the 'AllowNullLiteral' attribute may only inherit from or implement types which also allow the use of the null literal") + (Error 934, Line 27, Col 10, Line 27, Col 11, "Records, union, abbreviations and struct types cannot have the 'AllowNullLiteral' attribute") + (Error 934, Line 30, Col 10, Line 30, Col 11, "Records, union, abbreviations and struct types cannot have the 'AllowNullLiteral' attribute") + (Error 934, Line 33, Col 10, Line 33, Col 11, "Records, union, abbreviations and struct types cannot have the 'AllowNullLiteral' attribute") + (Error 934, Line 36, Col 10, Line 36, Col 11, "Records, union, abbreviations and struct types cannot have the 'AllowNullLiteral' attribute") + (Error 934, Line 39, Col 10, Line 39, Col 13, "Records, union, abbreviations and struct types cannot have the 'AllowNullLiteral' attribute") + (Error 842, Line 41, Col 7, Line 41, Col 23, "This attribute is not valid for use on this language element") + (Error 842, Line 44, Col 7, Line 44, Col 23, "This attribute is not valid for use on this language element") + ] + + // SOURCE=E_AllowNullLiteral.fs # E_AllowNullLiteral.fs + [] + let ``E_AllowNullLiteral preview`` compilation = + compilation + |> withLangVersionPreview + |> verifyCompile + |> shouldFail + |> withDiagnostics [ + (Error 935, Line 15, Col 10, Line 15, Col 11, "Types with the 'AllowNullLiteral' attribute may only inherit from or implement types which also allow the use of the null literal"); + (Error 934, Line 27, Col 10, Line 27, Col 11, "Records, union, abbreviations and struct types cannot have the 'AllowNullLiteral' attribute"); + (Error 934, Line 30, Col 10, Line 30, Col 11, "Records, union, abbreviations and struct types cannot have the 'AllowNullLiteral' attribute"); + (Error 934, Line 33, Col 10, Line 33, Col 11, "Records, union, abbreviations and struct types cannot have the 'AllowNullLiteral' attribute"); + (Error 934, Line 36, Col 10, Line 36, Col 11, "Records, union, abbreviations and struct types cannot have the 'AllowNullLiteral' attribute"); + (Error 934, Line 39, Col 10, Line 39, Col 13, "Records, union, abbreviations and struct types cannot have the 'AllowNullLiteral' attribute"); + (Error 842, Line 41, Col 7, Line 41, Col 23, "This attribute is not valid for use on this language element"); + (Error 842, Line 44, Col 7, Line 44, Col 23, "This attribute is not valid for use on this language element") + ] + + // SOURCE= AllowNullLiteral01.fs # AllowNullLiteral01.fs + [] + let ``AllowNullLiteral01 8.0`` compilation = + compilation + |> withLangVersion80 + |> verifyCompile + |> shouldSucceed + + // SOURCE=AllowNullLiteral01.fs # AllowNullLiteral01.fs + [] + let ``AllowNullLiteral01 preview`` compilation = + compilation + |> withLangVersionPreview + |> verifyCompile + |> shouldSucceed \ No newline at end of file diff --git a/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/CustomAttributes/AttributeUsage/E_AllowNullLiteral.fs b/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/CustomAttributes/AttributeUsage/E_AllowNullLiteral.fs new file mode 100644 index 00000000000..243abb38667 --- /dev/null +++ b/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/CustomAttributes/AttributeUsage/E_AllowNullLiteral.fs @@ -0,0 +1,48 @@ +module AllowNullLiteralTest = begin + + //[] + type I = + interface + abstract P : int + end + + //[] + type C() = + member x.P = 1 + + + [] + type D() = + inherit C() + interface I with + member x.P = 2 + member x.P = 1 + + let d = (null : D) + + let d2 = ((box null) :?> D) + + + [] // expect an error here + type S(c:int) = struct end + + [] // expect an error here + type R = { r : int } + + [] // expect an error here + type U = A | B of int + + [] // expect an error here + type E = A = 1 | B = 2 + + [] // expect an error here + type Del = delegate of int -> int + + [] // expect an error here + let x = 1 + + [] // expect an error here + let f x = 1 + +end + \ No newline at end of file From 2bef9cd9bcf7ac8ab20af019048e058380381734 Mon Sep 17 00:00:00 2001 From: Edgar Gonzalez Date: Wed, 21 Aug 2024 17:43:20 +0100 Subject: [PATCH 2/5] Account for AllowNullLiteralAttribute when checking attribute targets --- .../AttributeUsage/AllowNullLiteral01.fs | 3 ++ .../AttributeUsage/AttributeUsage.fs | 54 ++++++++++++++++++- .../AttributeUsage/E_AllowNullLiteral.fs | 48 +++++++++++++++++ 3 files changed, 104 insertions(+), 1 deletion(-) create mode 100644 tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/CustomAttributes/AttributeUsage/AllowNullLiteral01.fs create mode 100644 tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/CustomAttributes/AttributeUsage/E_AllowNullLiteral.fs diff --git a/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/CustomAttributes/AttributeUsage/AllowNullLiteral01.fs b/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/CustomAttributes/AttributeUsage/AllowNullLiteral01.fs new file mode 100644 index 00000000000..a51ad77a443 --- /dev/null +++ b/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/CustomAttributes/AttributeUsage/AllowNullLiteral01.fs @@ -0,0 +1,3 @@ +[] +type D() = + member x.P = 1 \ No newline at end of file diff --git a/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/CustomAttributes/AttributeUsage/AttributeUsage.fs b/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/CustomAttributes/AttributeUsage/AttributeUsage.fs index 68df8538d0c..27ab7d48738 100644 --- a/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/CustomAttributes/AttributeUsage/AttributeUsage.fs +++ b/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/CustomAttributes/AttributeUsage/AttributeUsage.fs @@ -738,4 +738,56 @@ type InterruptibleLazy<'T> private (valueFactory: unit -> 'T) = (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.") - ] \ No newline at end of file + ] + + // SOURCE= E_AllowNullLiteral.fs # E_AllowNullLiteral.fs + [] + let ``E_AllowNullLiteral 8.0`` compilation = + compilation + |> withLangVersion80 + |> verifyCompile + |> shouldFail + |> withDiagnostics [ + (Error 935, Line 15, Col 10, Line 15, Col 11, "Types with the 'AllowNullLiteral' attribute may only inherit from or implement types which also allow the use of the null literal") + (Error 934, Line 27, Col 10, Line 27, Col 11, "Records, union, abbreviations and struct types cannot have the 'AllowNullLiteral' attribute") + (Error 934, Line 30, Col 10, Line 30, Col 11, "Records, union, abbreviations and struct types cannot have the 'AllowNullLiteral' attribute") + (Error 934, Line 33, Col 10, Line 33, Col 11, "Records, union, abbreviations and struct types cannot have the 'AllowNullLiteral' attribute") + (Error 934, Line 36, Col 10, Line 36, Col 11, "Records, union, abbreviations and struct types cannot have the 'AllowNullLiteral' attribute") + (Error 934, Line 39, Col 10, Line 39, Col 13, "Records, union, abbreviations and struct types cannot have the 'AllowNullLiteral' attribute") + (Error 842, Line 41, Col 7, Line 41, Col 23, "This attribute is not valid for use on this language element") + (Error 842, Line 44, Col 7, Line 44, Col 23, "This attribute is not valid for use on this language element") + ] + + // SOURCE=E_AllowNullLiteral.fs # E_AllowNullLiteral.fs + [] + let ``E_AllowNullLiteral preview`` compilation = + compilation + |> withLangVersionPreview + |> verifyCompile + |> shouldFail + |> withDiagnostics [ + (Error 935, Line 15, Col 10, Line 15, Col 11, "Types with the 'AllowNullLiteral' attribute may only inherit from or implement types which also allow the use of the null literal") + (Error 934, Line 27, Col 10, Line 27, Col 11, "Records, union, abbreviations and struct types cannot have the 'AllowNullLiteral' attribute") + (Error 934, Line 30, Col 10, Line 30, Col 11, "Records, union, abbreviations and struct types cannot have the 'AllowNullLiteral' attribute") + (Error 934, Line 33, Col 10, Line 33, Col 11, "Records, union, abbreviations and struct types cannot have the 'AllowNullLiteral' attribute") + (Error 934, Line 36, Col 10, Line 36, Col 11, "Records, union, abbreviations and struct types cannot have the 'AllowNullLiteral' attribute") + (Error 934, Line 39, Col 10, Line 39, Col 13, "Records, union, abbreviations and struct types cannot have the 'AllowNullLiteral' attribute") + (Error 842, Line 41, Col 7, Line 41, Col 23, "This attribute is not valid for use on this language element") + (Error 842, Line 44, Col 7, Line 44, Col 23, "This attribute is not valid for use on this language element") + ] + + // SOURCE= AllowNullLiteral01.fs # AllowNullLiteral01.fs + [] + let ``AllowNullLiteral01 8.0`` compilation = + compilation + |> withLangVersion80 + |> verifyCompile + |> shouldSucceed + + // SOURCE=AllowNullLiteral01.fs # AllowNullLiteral01.fs + [] + let ``AllowNullLiteral01 preview`` compilation = + compilation + |> withLangVersionPreview + |> verifyCompile + |> shouldSucceed \ No newline at end of file diff --git a/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/CustomAttributes/AttributeUsage/E_AllowNullLiteral.fs b/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/CustomAttributes/AttributeUsage/E_AllowNullLiteral.fs new file mode 100644 index 00000000000..243abb38667 --- /dev/null +++ b/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/CustomAttributes/AttributeUsage/E_AllowNullLiteral.fs @@ -0,0 +1,48 @@ +module AllowNullLiteralTest = begin + + //[] + type I = + interface + abstract P : int + end + + //[] + type C() = + member x.P = 1 + + + [] + type D() = + inherit C() + interface I with + member x.P = 2 + member x.P = 1 + + let d = (null : D) + + let d2 = ((box null) :?> D) + + + [] // expect an error here + type S(c:int) = struct end + + [] // expect an error here + type R = { r : int } + + [] // expect an error here + type U = A | B of int + + [] // expect an error here + type E = A = 1 | B = 2 + + [] // expect an error here + type Del = delegate of int -> int + + [] // expect an error here + let x = 1 + + [] // expect an error here + let f x = 1 + +end + \ No newline at end of file From 78cc0660b0bc651e73ad5a3beedfad699173d587 Mon Sep 17 00:00:00 2001 From: Edgar Gonzalez Date: Thu, 22 Aug 2024 16:09:19 +0100 Subject: [PATCH 3/5] Update tests --- src/Compiler/Checking/CheckDeclarations.fs | 53 ++++++++++--------- .../AttributeUsage/AttributeUsage.fs | 2 +- 2 files changed, 28 insertions(+), 27 deletions(-) diff --git a/src/Compiler/Checking/CheckDeclarations.fs b/src/Compiler/Checking/CheckDeclarations.fs index feabed1fbc4..5dcf3fca4bb 100644 --- a/src/Compiler/Checking/CheckDeclarations.fs +++ b/src/Compiler/Checking/CheckDeclarations.fs @@ -2855,23 +2855,14 @@ module EstablishTypeDefinitionCores = 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 hasAllowNullLiteralAttr = HasFSharpAttribute g g.attrib_AllowNullLiteralAttribute attrs - let reportAttributeTargetsErrors = g.langVersion.SupportsFeature(LanguageFeature.EnforceAttributeTargets) && (not hasCLIMutable || not hasAllowNullLiteralAttr) + // 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 && not hasAllowNullLiteralAttr let noCLIMutableAttributeCheck() = if hasCLIMutable then errorR (Error(FSComp.SR.tcThisTypeMayNotHaveACLIMutableAttribute(), m)) - - let noAllowNullLiteralAttributeCheck() = - if hasAllowNullLiteralAttr then errorR (Error(FSComp.SR.tcRecordsUnionsAbbreviationsStructsMayNotHaveAllowNullLiteralAttribute(), m)) - - let allowNullLiteralAttributeCheck() = - if hasAllowNullLiteralAttr then - tycon.TypeContents.tcaug_super |> Option.iter (fun ty -> if not (TypeNullIsExtraValue g m ty) then errorR (Error(FSComp.SR.tcAllowNullTypesMayOnlyInheritFromAllowNullTypes(), m))) - tycon.ImmediateInterfaceTypesOfFSharpTycon |> List.iter (fun ty -> if not (TypeNullIsExtraValue g m ty) then errorR (Error(FSComp.SR.tcAllowNullTypesMayOnlyInheritFromAllowNullTypes(), m))) let isStructRecordOrUnionType = match synTyconRepr with @@ -2896,7 +2887,6 @@ module EstablishTypeDefinitionCores = | SynTypeDefnSimpleRepr.Exception _ -> TNoRepr | SynTypeDefnSimpleRepr.None m -> // Run InferTyconKind to raise errors on inconsistent attribute sets - noAllowNullLiteralAttributeCheck() InferTyconKind g (SynTypeDefnKind.Opaque, attrs, [], [], inSig, true, m) |> ignore if not inSig && not hasMeasureAttr then errorR(Error(FSComp.SR.tcTypeRequiresDefinition(), m)) @@ -2908,7 +2898,6 @@ module EstablishTypeDefinitionCores = | TyconCoreAbbrevThatIsReallyAUnion (hasMeasureAttr, envinner, id) (_, m) | SynTypeDefnSimpleRepr.Union (_, _, m) -> noCLIMutableAttributeCheck() - noAllowNullLiteralAttributeCheck() // Run InferTyconKind to raise errors on inconsistent attribute sets InferTyconKind g (SynTypeDefnKind.Union, attrs, [], [], inSig, true, m) |> ignore @@ -2923,21 +2912,18 @@ module EstablishTypeDefinitionCores = | SynTypeDefnSimpleRepr.TypeAbbrev _ -> // Run InferTyconKind to raise errors on inconsistent attribute sets - noAllowNullLiteralAttributeCheck() InferTyconKind g (SynTypeDefnKind.Abbrev, attrs, [], [], inSig, true, m) |> ignore TNoRepr | SynTypeDefnSimpleRepr.LibraryOnlyILAssembly (s, m) -> let s = (s :?> ILType) noCLIMutableAttributeCheck() - noAllowNullLiteralAttributeCheck() // 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 - noAllowNullLiteralAttributeCheck() InferTyconKind g (SynTypeDefnKind.Record, attrs, [], [], inSig, true, m) |> ignore if reportAttributeTargetsErrors then @@ -2953,29 +2939,24 @@ module EstablishTypeDefinitionCores = let kind = InferTyconKind g (kind, attrs, slotsigs, fields, inSig, isConcrete, m) noCLIMutableAttributeCheck() match kind with - | SynTypeDefnKind.Opaque -> - noAllowNullLiteralAttributeCheck() + | SynTypeDefnKind.Opaque -> TNoRepr | _ -> let kind = match kind with | SynTypeDefnKind.Class -> - allowNullLiteralAttributeCheck() if reportAttributeTargetsErrors then TcAttributesWithPossibleTargets false cenv envinner AttributeTargets.Class synAttrs |> ignore TFSharpClass | SynTypeDefnKind.Interface -> - allowNullLiteralAttributeCheck() if reportAttributeTargetsErrors then TcAttributesWithPossibleTargets false cenv envinner AttributeTargets.Interface synAttrs |> ignore TFSharpInterface | SynTypeDefnKind.Delegate _ -> - noAllowNullLiteralAttributeCheck() if reportAttributeTargetsErrors then TcAttributesWithPossibleTargets false cenv envinner AttributeTargets.Delegate synAttrs |> ignore TFSharpDelegate (MakeSlotSig("Invoke", g.unit_ty, [], [], [], None)) | SynTypeDefnKind.Struct -> - noAllowNullLiteralAttributeCheck() if reportAttributeTargetsErrors then TcAttributesWithPossibleTargets false cenv envinner AttributeTargets.Struct synAttrs |> ignore TFSharpStruct @@ -2985,8 +2966,6 @@ module EstablishTypeDefinitionCores = | SynTypeDefnSimpleRepr.Enum _ -> noCLIMutableAttributeCheck() - noAllowNullLiteralAttributeCheck() - if reportAttributeTargetsErrors then TcAttributesWithPossibleTargets false cenv envinner AttributeTargets.Enum synAttrs |> ignore TFSharpTyconRepr (Construct.NewEmptyFSharpTyconData TFSharpEnum) @@ -3402,6 +3381,7 @@ module EstablishTypeDefinitionCores = let hasMeasureableAttr = HasFSharpAttribute g g.attrib_MeasureableAttribute attrs let structLayoutAttr = TryFindFSharpInt32Attribute g g.attrib_StructLayoutAttribute attrs + let hasAllowNullLiteralAttr = TryFindFSharpBoolAttribute g g.attrib_AllowNullLiteralAttribute attrs = Some true if hasAbstractAttr then tycon.TypeContents.tcaug_abstract <- true @@ -3409,7 +3389,16 @@ module EstablishTypeDefinitionCores = tycon.entity_attribs <- attrs let noAbstractClassAttributeCheck() = if hasAbstractAttr then errorR (Error(FSComp.SR.tcOnlyClassesCanHaveAbstract(), m)) - + + let noAllowNullLiteralAttributeCheck() = + if hasAllowNullLiteralAttr then errorR (Error(FSComp.SR.tcRecordsUnionsAbbreviationsStructsMayNotHaveAllowNullLiteralAttribute(), m)) + + + let allowNullLiteralAttributeCheck() = + if hasAllowNullLiteralAttr then + tycon.TypeContents.tcaug_super |> Option.iter (fun ty -> if not (TypeNullIsExtraValue g m ty) then errorR (Error(FSComp.SR.tcAllowNullTypesMayOnlyInheritFromAllowNullTypes(), m))) + tycon.ImmediateInterfaceTypesOfFSharpTycon |> List.iter (fun ty -> if not (TypeNullIsExtraValue g m ty) then errorR (Error(FSComp.SR.tcAllowNullTypesMayOnlyInheritFromAllowNullTypes(), m))) + let structLayoutAttributeCheck allowed = let explicitKind = int32 System.Runtime.InteropServices.LayoutKind.Explicit match structLayoutAttr with @@ -3504,6 +3493,7 @@ module EstablishTypeDefinitionCores = | SynTypeDefnSimpleRepr.None _ -> hiddenReprChecks false + noAllowNullLiteralAttributeCheck() if hasMeasureAttr then let repr = TFSharpTyconRepr (Construct.NewEmptyFSharpTyconData TFSharpClass) repr, None, NoSafeInitInfo @@ -3517,6 +3507,7 @@ module EstablishTypeDefinitionCores = | TyconCoreAbbrevThatIsReallyAUnion (hasMeasureAttr, envinner, id) (unionCaseName, _) -> structLayoutAttributeCheck false + noAllowNullLiteralAttributeCheck() let hasRQAAttribute = HasFSharpAttribute cenv.g cenv.g.attrib_RequireQualifiedAccessAttribute tycon.Attribs TcRecdUnionAndEnumDeclarations.CheckUnionCaseName cenv unionCaseName hasRQAAttribute @@ -3531,6 +3522,7 @@ module EstablishTypeDefinitionCores = if hasSealedAttr = Some true then errorR (Error(FSComp.SR.tcAbbreviatedTypesCannotBeSealed(), m)) noAbstractClassAttributeCheck() + noAllowNullLiteralAttributeCheck() if hasMeasureableAttr then let kind = if hasMeasureAttr then TyparKind.Measure else TyparKind.Type let theTypeAbbrev, _ = TcTypeOrMeasureAndRecover (Some kind) cenv NoNewTypars CheckCxs ItemOccurrence.UseInType WarnOnIWSAM.No envinner tpenv rhsType @@ -3546,6 +3538,7 @@ module EstablishTypeDefinitionCores = noMeasureAttributeCheck() noSealedAttributeCheck FSComp.SR.tcTypesAreAlwaysSealedDU noAbstractClassAttributeCheck() + noAllowNullLiteralAttributeCheck() structLayoutAttributeCheck false let hasRQAAttribute = HasFSharpAttribute cenv.g cenv.g.attrib_RequireQualifiedAccessAttribute tycon.Attribs @@ -3561,6 +3554,7 @@ module EstablishTypeDefinitionCores = noMeasureAttributeCheck() noSealedAttributeCheck FSComp.SR.tcTypesAreAlwaysSealedRecord noAbstractClassAttributeCheck() + noAllowNullLiteralAttributeCheck() structLayoutAttributeCheck true // these are allowed for records let recdFields = TcRecdUnionAndEnumDeclarations.TcNamedFieldDecls cenv envinner innerParent false tpenv fields recdFields |> CheckDuplicates (fun f -> f.Id) "field" |> ignore @@ -3582,6 +3576,7 @@ module EstablishTypeDefinitionCores = let s = (s :?> ILType) noMeasureAttributeCheck() noSealedAttributeCheck FSComp.SR.tcTypesAreAlwaysSealedAssemblyCode + noAllowNullLiteralAttributeCheck() structLayoutAttributeCheck false noAbstractClassAttributeCheck() TAsmRepr s, None, NoSafeInitInfo @@ -3614,6 +3609,7 @@ module EstablishTypeDefinitionCores = match kind with | SynTypeDefnKind.Opaque -> hiddenReprChecks true + noAllowNullLiteralAttributeCheck() TNoRepr, None, NoSafeInitInfo | _ -> @@ -3645,6 +3641,7 @@ module EstablishTypeDefinitionCores = | SynTypeDefnKind.Struct -> noSealedAttributeCheck FSComp.SR.tcTypesAreAlwaysSealedStruct noAbstractClassAttributeCheck() + noAllowNullLiteralAttributeCheck() if not (isNil slotsigs) then errorR (Error(FSComp.SR.tcStructTypesCannotContainAbstractMembers(), m)) structLayoutAttributeCheck true @@ -3654,10 +3651,12 @@ module EstablishTypeDefinitionCores = if hasSealedAttr = Some true then errorR (Error(FSComp.SR.tcInterfaceTypesCannotBeSealed(), m)) structLayoutAttributeCheck false noAbstractClassAttributeCheck() + allowNullLiteralAttributeCheck() noFieldsCheck userFields TFSharpInterface | SynTypeDefnKind.Class -> structLayoutAttributeCheck(not isIncrClass) + allowNullLiteralAttributeCheck() for slot in abstractSlots do if not slot.IsInstanceMember then errorR(Error(FSComp.SR.chkStaticAbstractMembersOnClasses(), slot.Range)) @@ -3665,6 +3664,7 @@ module EstablishTypeDefinitionCores = | SynTypeDefnKind.Delegate (ty, arity) -> noSealedAttributeCheck FSComp.SR.tcTypesAreAlwaysSealedDelegate structLayoutAttributeCheck false + noAllowNullLiteralAttributeCheck() noAbstractClassAttributeCheck() noFieldsCheck userFields primaryConstructorInDelegateCheck(implicitCtorSynPats) @@ -3713,6 +3713,7 @@ module EstablishTypeDefinitionCores = let kind = TFSharpEnum structLayoutAttributeCheck false noSealedAttributeCheck FSComp.SR.tcTypesAreAlwaysSealedEnum + noAllowNullLiteralAttributeCheck() let vid = ident("value__", m) let vfld = Construct.NewRecdField false None vid false fieldTy false false [] [] XmlDoc.Empty taccessPublic true diff --git a/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/CustomAttributes/AttributeUsage/AttributeUsage.fs b/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/CustomAttributes/AttributeUsage/AttributeUsage.fs index 27ab7d48738..ce6efe8033e 100644 --- a/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/CustomAttributes/AttributeUsage/AttributeUsage.fs +++ b/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/CustomAttributes/AttributeUsage/AttributeUsage.fs @@ -772,7 +772,7 @@ type InterruptibleLazy<'T> private (valueFactory: unit -> 'T) = (Error 934, Line 33, Col 10, Line 33, Col 11, "Records, union, abbreviations and struct types cannot have the 'AllowNullLiteral' attribute") (Error 934, Line 36, Col 10, Line 36, Col 11, "Records, union, abbreviations and struct types cannot have the 'AllowNullLiteral' attribute") (Error 934, Line 39, Col 10, Line 39, Col 13, "Records, union, abbreviations and struct types cannot have the 'AllowNullLiteral' attribute") - (Error 842, Line 41, Col 7, Line 41, Col 23, "This attribute is not valid for use on this language element") + (Error 842, Line 41, Col 7, Line 41, Col 23, "This attribute is not valid for use on this language element"); (Error 842, Line 44, Col 7, Line 44, Col 23, "This attribute is not valid for use on this language element") ] From 0b4f9c41d1a5464b38d8ce9e4a6d538d6bc5b30c Mon Sep 17 00:00:00 2001 From: Edgar Gonzalez Date: Thu, 22 Aug 2024 17:18:30 +0100 Subject: [PATCH 4/5] Update tests --- tests/fsharp/typecheck/sigs/neg16.bsl | 6 ------ 1 file changed, 6 deletions(-) diff --git a/tests/fsharp/typecheck/sigs/neg16.bsl b/tests/fsharp/typecheck/sigs/neg16.bsl index 4a6dde0f034..1440ccc78d3 100644 --- a/tests/fsharp/typecheck/sigs/neg16.bsl +++ b/tests/fsharp/typecheck/sigs/neg16.bsl @@ -3,20 +3,14 @@ neg16.fs(7,13,7,16): typecheck error FS0644: Namespaces cannot contain extension neg16.fs(23,10,23,11): typecheck error FS0935: Types with the 'AllowNullLiteral' attribute may only inherit from or implement types which also allow the use of the null literal -neg16.fs(34,7,34,23): typecheck error FS0842: This attribute is not valid for use on this language element - neg16.fs(35,10,35,11): typecheck error FS0934: Records, union, abbreviations and struct types cannot have the 'AllowNullLiteral' attribute neg16.fs(38,10,38,11): typecheck error FS0934: Records, union, abbreviations and struct types cannot have the 'AllowNullLiteral' attribute neg16.fs(41,10,41,11): typecheck error FS0934: Records, union, abbreviations and struct types cannot have the 'AllowNullLiteral' attribute -neg16.fs(43,7,43,23): typecheck error FS0842: This attribute is not valid for use on this language element - neg16.fs(44,10,44,11): typecheck error FS0934: Records, union, abbreviations and struct types cannot have the 'AllowNullLiteral' attribute -neg16.fs(46,7,46,23): typecheck error FS0842: This attribute is not valid for use on this language element - neg16.fs(47,10,47,13): typecheck error FS0934: Records, union, abbreviations and struct types cannot have the 'AllowNullLiteral' attribute neg16.fs(49,7,49,23): typecheck error FS0842: This attribute is not valid for use on this language element From 3b5e857d1a463f653ecee5f0dbc9492752529f60 Mon Sep 17 00:00:00 2001 From: Edgar Gonzalez Date: Fri, 23 Aug 2024 09:29:46 +0100 Subject: [PATCH 5/5] Add some comments --- src/Compiler/Checking/CheckDeclarations.fs | 10 ++++++---- 1 file changed, 6 insertions(+), 4 deletions(-) diff --git a/src/Compiler/Checking/CheckDeclarations.fs b/src/Compiler/Checking/CheckDeclarations.fs index 5dcf3fca4bb..0f67c71ee3a 100644 --- a/src/Compiler/Checking/CheckDeclarations.fs +++ b/src/Compiler/Checking/CheckDeclarations.fs @@ -2856,10 +2856,12 @@ module EstablishTypeDefinitionCores = let hasStructAttr = HasFSharpAttribute g g.attrib_StructAttribute attrs let hasCLIMutable = HasFSharpAttribute g g.attrib_CLIMutableAttribute attrs let hasAllowNullLiteralAttr = HasFSharpAttribute g g.attrib_AllowNullLiteralAttribute 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 && not hasAllowNullLiteralAttr + + // We want to keep these special attributes treatment and avoid having two errors for the same attribute. + let reportAttributeTargetsErrors = + g.langVersion.SupportsFeature(LanguageFeature.EnforceAttributeTargets) + && not hasCLIMutable // CLIMutableAttribute has a special treatment(specific error FS3132) + && not hasAllowNullLiteralAttr // AllowNullLiteralAttribute has a special treatment(specific errors FS0934, FS093) let noCLIMutableAttributeCheck() = if hasCLIMutable then errorR (Error(FSComp.SR.tcThisTypeMayNotHaveACLIMutableAttribute(), m))