From 4e85c3a81ccae955af115928d0e88ae53a4940cf Mon Sep 17 00:00:00 2001 From: Edgar Gonzalez Date: Mon, 5 May 2025 13:49:45 +0100 Subject: [PATCH 1/9] raise an opt-in warning attribute not valid for union case with fields --- src/Compiler/Checking/CheckDeclarations.fs | 43 ++++++++++++------- src/Compiler/Driver/CompilerDiagnostics.fs | 1 + src/Compiler/FSComp.txt | 1 + src/Compiler/xlf/FSComp.txt.cs.xlf | 5 +++ src/Compiler/xlf/FSComp.txt.de.xlf | 5 +++ src/Compiler/xlf/FSComp.txt.es.xlf | 5 +++ src/Compiler/xlf/FSComp.txt.fr.xlf | 5 +++ src/Compiler/xlf/FSComp.txt.it.xlf | 5 +++ src/Compiler/xlf/FSComp.txt.ja.xlf | 5 +++ src/Compiler/xlf/FSComp.txt.ko.xlf | 5 +++ src/Compiler/xlf/FSComp.txt.pl.xlf | 5 +++ src/Compiler/xlf/FSComp.txt.pt-BR.xlf | 5 +++ src/Compiler/xlf/FSComp.txt.ru.xlf | 5 +++ src/Compiler/xlf/FSComp.txt.tr.xlf | 5 +++ src/Compiler/xlf/FSComp.txt.zh-Hans.xlf | 5 +++ src/Compiler/xlf/FSComp.txt.zh-Hant.xlf | 5 +++ .../AttributeUsage/AttributeUsage.fs | 7 +-- 17 files changed, 95 insertions(+), 22 deletions(-) diff --git a/src/Compiler/Checking/CheckDeclarations.fs b/src/Compiler/Checking/CheckDeclarations.fs index 78acf62bb98..69f339c5c24 100644 --- a/src/Compiler/Checking/CheckDeclarations.fs +++ b/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 target + if targetEnum <> AttributeTargets.Method && targetEnum <> AttributeTargets.All then + warning(Error(FSComp.SR.tcAttributeIsNotValidForUnionCaseWithFields(), id.idRange))) Construct.NewUnionCase id rfields recordTy attrs xmlDoc vis diff --git a/src/Compiler/Driver/CompilerDiagnostics.fs b/src/Compiler/Driver/CompilerDiagnostics.fs index 68813e69a83..3da96b19af6 100644 --- a/src/Compiler/Driver/CompilerDiagnostics.fs +++ b/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 diff --git a/src/Compiler/FSComp.txt b/src/Compiler/FSComp.txt index 9bfa12ce963..1626a16eb71 100644 --- a/src/Compiler/FSComp.txt +++ b/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 [] 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()`." diff --git a/src/Compiler/xlf/FSComp.txt.cs.xlf b/src/Compiler/xlf/FSComp.txt.cs.xlf index 7d64601c303..7ef1a1e84cc 100644 --- a/src/Compiler/xlf/FSComp.txt.cs.xlf +++ b/src/Compiler/xlf/FSComp.txt.cs.xlf @@ -1357,6 +1357,11 @@ Pole {0} se v tomto anonymním typu záznamu vyskytuje vícekrát. + + This attribute is not valid for use on union cases with fields. + This attribute is not valid for use on union cases with fields. + + Attributes cannot be applied to type extensions. Atributy nejde použít pro rozšíření typů. diff --git a/src/Compiler/xlf/FSComp.txt.de.xlf b/src/Compiler/xlf/FSComp.txt.de.xlf index 67f4270377e..25dbe4e488b 100644 --- a/src/Compiler/xlf/FSComp.txt.de.xlf +++ b/src/Compiler/xlf/FSComp.txt.de.xlf @@ -1357,6 +1357,11 @@ Das Feld "{0}" ist in diesem anonymen Datensatztyp mehrmals vorhanden. + + This attribute is not valid for use on union cases with fields. + This attribute is not valid for use on union cases with fields. + + Attributes cannot be applied to type extensions. Attribute können nicht auf Typerweiterungen angewendet werden. diff --git a/src/Compiler/xlf/FSComp.txt.es.xlf b/src/Compiler/xlf/FSComp.txt.es.xlf index 9478e3d2c55..435451353fe 100644 --- a/src/Compiler/xlf/FSComp.txt.es.xlf +++ b/src/Compiler/xlf/FSComp.txt.es.xlf @@ -1357,6 +1357,11 @@ El campo "{0}" aparece varias veces en este tipo de registro anónimo. + + This attribute is not valid for use on union cases with fields. + This attribute is not valid for use on union cases with fields. + + Attributes cannot be applied to type extensions. Los atributos no se pueden aplicar a las extensiones de tipo. diff --git a/src/Compiler/xlf/FSComp.txt.fr.xlf b/src/Compiler/xlf/FSComp.txt.fr.xlf index 57fade5d250..61f3c03243a 100644 --- a/src/Compiler/xlf/FSComp.txt.fr.xlf +++ b/src/Compiler/xlf/FSComp.txt.fr.xlf @@ -1357,6 +1357,11 @@ Le champ '{0}' apparaît plusieurs fois dans ce type d'enregistrement anonyme. + + This attribute is not valid for use on union cases with fields. + This attribute is not valid for use on union cases with fields. + + Attributes cannot be applied to type extensions. Impossible d'appliquer des attributs aux extensions de type. diff --git a/src/Compiler/xlf/FSComp.txt.it.xlf b/src/Compiler/xlf/FSComp.txt.it.xlf index 14d670e8455..463590f2675 100644 --- a/src/Compiler/xlf/FSComp.txt.it.xlf +++ b/src/Compiler/xlf/FSComp.txt.it.xlf @@ -1357,6 +1357,11 @@ Il campo '{0}' viene visualizzato più volte in questo tipo di record anonimo. + + This attribute is not valid for use on union cases with fields. + This attribute is not valid for use on union cases with fields. + + Attributes cannot be applied to type extensions. Gli attributi non possono essere applicati a estensioni di tipo. diff --git a/src/Compiler/xlf/FSComp.txt.ja.xlf b/src/Compiler/xlf/FSComp.txt.ja.xlf index 78acb0fd944..de974fa04c0 100644 --- a/src/Compiler/xlf/FSComp.txt.ja.xlf +++ b/src/Compiler/xlf/FSComp.txt.ja.xlf @@ -1357,6 +1357,11 @@ この匿名レコードの種類に、フィールド '{0}' が複数回出現します。 + + This attribute is not valid for use on union cases with fields. + This attribute is not valid for use on union cases with fields. + + Attributes cannot be applied to type extensions. 属性を型拡張に適用することはできません。 diff --git a/src/Compiler/xlf/FSComp.txt.ko.xlf b/src/Compiler/xlf/FSComp.txt.ko.xlf index 604ac431e4a..6fe073a8b24 100644 --- a/src/Compiler/xlf/FSComp.txt.ko.xlf +++ b/src/Compiler/xlf/FSComp.txt.ko.xlf @@ -1357,6 +1357,11 @@ '{0}' 필드가 이 익명 레코드 형식에서 여러 번 나타납니다. + + This attribute is not valid for use on union cases with fields. + This attribute is not valid for use on union cases with fields. + + Attributes cannot be applied to type extensions. 형식 확장에 특성을 적용할 수 없습니다. diff --git a/src/Compiler/xlf/FSComp.txt.pl.xlf b/src/Compiler/xlf/FSComp.txt.pl.xlf index fdee3d82f7d..b8a17f1a3ed 100644 --- a/src/Compiler/xlf/FSComp.txt.pl.xlf +++ b/src/Compiler/xlf/FSComp.txt.pl.xlf @@ -1357,6 +1357,11 @@ Pole „{0}” występuje wielokrotnie w tym anonimowym typie rekordu. + + This attribute is not valid for use on union cases with fields. + This attribute is not valid for use on union cases with fields. + + Attributes cannot be applied to type extensions. Atrybutów nie można stosować do rozszerzeń typu. diff --git a/src/Compiler/xlf/FSComp.txt.pt-BR.xlf b/src/Compiler/xlf/FSComp.txt.pt-BR.xlf index 2f86c57d960..f431f9c4968 100644 --- a/src/Compiler/xlf/FSComp.txt.pt-BR.xlf +++ b/src/Compiler/xlf/FSComp.txt.pt-BR.xlf @@ -1357,6 +1357,11 @@ O campo '{0}' aparece várias vezes nesse tipo de registro anônimo. + + This attribute is not valid for use on union cases with fields. + This attribute is not valid for use on union cases with fields. + + Attributes cannot be applied to type extensions. Os atributos não podem ser aplicados às extensões de tipo. diff --git a/src/Compiler/xlf/FSComp.txt.ru.xlf b/src/Compiler/xlf/FSComp.txt.ru.xlf index fefd5255a0b..927dbd0fefa 100644 --- a/src/Compiler/xlf/FSComp.txt.ru.xlf +++ b/src/Compiler/xlf/FSComp.txt.ru.xlf @@ -1357,6 +1357,11 @@ Поле "{0}" появляется несколько раз в этом типе анонимной записи. + + This attribute is not valid for use on union cases with fields. + This attribute is not valid for use on union cases with fields. + + Attributes cannot be applied to type extensions. Атрибуты не могут быть применены к расширениям типа. diff --git a/src/Compiler/xlf/FSComp.txt.tr.xlf b/src/Compiler/xlf/FSComp.txt.tr.xlf index 5325f0ab09f..978bad0de9f 100644 --- a/src/Compiler/xlf/FSComp.txt.tr.xlf +++ b/src/Compiler/xlf/FSComp.txt.tr.xlf @@ -1357,6 +1357,11 @@ '{0}' alanı bu anonim kayıt türünde birden fazla yerde görünüyor. + + This attribute is not valid for use on union cases with fields. + This attribute is not valid for use on union cases with fields. + + Attributes cannot be applied to type extensions. Öznitelikler tür uzantılarına uygulanamaz. diff --git a/src/Compiler/xlf/FSComp.txt.zh-Hans.xlf b/src/Compiler/xlf/FSComp.txt.zh-Hans.xlf index 2e8b957d810..345049cfe8c 100644 --- a/src/Compiler/xlf/FSComp.txt.zh-Hans.xlf +++ b/src/Compiler/xlf/FSComp.txt.zh-Hans.xlf @@ -1357,6 +1357,11 @@ 字段“{0}”在此匿名记录类型中多次出现。 + + This attribute is not valid for use on union cases with fields. + This attribute is not valid for use on union cases with fields. + + Attributes cannot be applied to type extensions. 属性不可应用于类型扩展。 diff --git a/src/Compiler/xlf/FSComp.txt.zh-Hant.xlf b/src/Compiler/xlf/FSComp.txt.zh-Hant.xlf index f0924b3d30f..9afda41de3f 100644 --- a/src/Compiler/xlf/FSComp.txt.zh-Hant.xlf +++ b/src/Compiler/xlf/FSComp.txt.zh-Hant.xlf @@ -1357,6 +1357,11 @@ 欄位 '{0}' 在這個匿名記錄類型中出現多次。 + + This attribute is not valid for use on union cases with fields. + This attribute is not valid for use on union cases with fields. + + Attributes cannot be applied to type extensions. 屬性無法套用到類型延伸模組。 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 c7c2cf72eca..fe2db9c7d74 100644 --- a/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/CustomAttributes/AttributeUsage/AttributeUsage.fs +++ b/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 [] From 85aa7f359b9a391a62ddc218b427bb00dd0aafee Mon Sep 17 00:00:00 2001 From: edgargonzalez Date: Fri, 16 May 2025 11:11:41 +0100 Subject: [PATCH 2/9] release notes --- docs/release-notes/.FSharp.Compiler.Service/10.0.100.md | 3 +++ 1 file changed, 3 insertions(+) create mode 100644 docs/release-notes/.FSharp.Compiler.Service/10.0.100.md diff --git a/docs/release-notes/.FSharp.Compiler.Service/10.0.100.md b/docs/release-notes/.FSharp.Compiler.Service/10.0.100.md new file mode 100644 index 00000000000..78ac94f56db --- /dev/null +++ b/docs/release-notes/.FSharp.Compiler.Service/10.0.100.md @@ -0,0 +1,3 @@ +### Added + +* Add opt-in warning attribute not valid for union case with fields [PR #18532](https://github.com/dotnet/fsharp/pull/18532)) \ No newline at end of file From 7fd3f5157a44f42937e2cc36a774dd2be1fbf1c5 Mon Sep 17 00:00:00 2001 From: edgargonzalez Date: Fri, 16 May 2025 11:46:07 +0100 Subject: [PATCH 3/9] Update FSComp --- src/Compiler/FSComp.txt | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/Compiler/FSComp.txt b/src/Compiler/FSComp.txt index da6f1296e50..e11f9689d4d 100644 --- a/src/Compiler/FSComp.txt +++ b/src/Compiler/FSComp.txt @@ -1795,7 +1795,6 @@ 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 [] 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()`." @@ -1804,4 +1803,5 @@ featureScopedNowarn,"Support for scoped enabling / disabling of warnings by #war 3874,lexWarnDirectiveMustBeFirst,"#nowarn/#warnon directives must appear as the first non-whitespace characters on a line" 3875,lexWarnDirectiveMustHaveArgs,"Warn directives must have warning number(s) as argument(s)" 3876,lexWarnDirectivesMustMatch,"There is another %s for this warning already in line %d." -3877,lexLineDirectiveMappingIsNotUnique,"The file '%s' was also pointed to in a line directive in '%s'. Proper warn directive application may not be possible." \ No newline at end of file +3877,lexLineDirectiveMappingIsNotUnique,"The file '%s' was also pointed to in a line directive in '%s'. Proper warn directive application may not be possible." +3878,tcAttributeIsNotValidForUnionCaseWithFields,"This attribute is not valid for use on union cases with fields." \ No newline at end of file From 995b7b6ef7fd07c19dc50a3e5fa323560dbe763a Mon Sep 17 00:00:00 2001 From: edgargonzalez Date: Fri, 16 May 2025 11:48:21 +0100 Subject: [PATCH 4/9] 3878 -> false --- src/Compiler/Driver/CompilerDiagnostics.fs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Compiler/Driver/CompilerDiagnostics.fs b/src/Compiler/Driver/CompilerDiagnostics.fs index b077a1ec440..81a8cc34516 100644 --- a/src/Compiler/Driver/CompilerDiagnostics.fs +++ b/src/Compiler/Driver/CompilerDiagnostics.fs @@ -402,7 +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 + | 3878 -> false // tcAttributeIsNotValidForUnionCaseWithFields - off by default | _ -> match x.Exception with | DiagnosticEnabledWithLanguageFeature(_, _, _, enabled) -> enabled From d136e4754837168379199633a2af885726661757 Mon Sep 17 00:00:00 2001 From: edgargonzalez Date: Fri, 16 May 2025 17:38:57 +0100 Subject: [PATCH 5/9] Update test --- .../CustomAttributes/AttributeUsage/AttributeUsage.fs | 1 - 1 file changed, 1 deletion(-) 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 60c5603ceab..dea9a10804d 100644 --- a/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/CustomAttributes/AttributeUsage/AttributeUsage.fs +++ b/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/CustomAttributes/AttributeUsage/AttributeUsage.fs @@ -493,7 +493,6 @@ module CustomAttributes_AttributeUsage = |> shouldFail |> withDiagnostics [ (Warning 842, Line 14, Col 5, Line 14, Col 15, "This attribute is not valid for use on this language element") - (Warning 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 From fdc2ea91f12138b5297fd9e7e9850594601d4fa4 Mon Sep 17 00:00:00 2001 From: Edgar Gonzalez Date: Sat, 17 May 2025 23:11:29 +0100 Subject: [PATCH 6/9] add opt-in warning tests --- .../AttributeUsage/AttributeUsage.fs | 36 +++++++++++++++++++ 1 file changed, 36 insertions(+) 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 dea9a10804d..b0fa891d2b7 100644 --- a/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/CustomAttributes/AttributeUsage/AttributeUsage.fs +++ b/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/CustomAttributes/AttributeUsage/AttributeUsage.fs @@ -64,6 +64,7 @@ module CustomAttributes_AttributeUsage = let ``AttributeTargetsIsMethod01_fs 8.0`` compilation = compilation |> withLangVersion80 + |> withWarnOn 3878 |> verifyCompileAndRun |> shouldSucceed @@ -74,6 +75,15 @@ module CustomAttributes_AttributeUsage = |> verifyCompileAndRun |> shouldSucceed + // SOURCE=AttributeTargetsIsMethod01.fs # AttributeTargetsIsMethod01.fs + [] + let ``Preview: AttributeTargetsIsMethod01_fs opt-in warning`` compilation = + compilation + |> withLangVersionPreview + |> withWarnOn 3878 + |> verifyCompileAndRun + |> shouldSucceed + // SOURCE=AttributeTargetsIsProperty.fs # AttributeTargetsIsProperty.fs [] let ``AttributeTargetsIsProperty_fs 8.0`` compilation = @@ -483,6 +493,18 @@ module CustomAttributes_AttributeUsage = |> withDiagnostics [ (Warning 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 + [] + let ``E_AttributeTargetIsField03_fs opt-in warning`` compilation = + compilation + |> withLangVersion90 + |> withWarnOn 3878 + |> verifyCompile + |> shouldFail + |> withDiagnostics [ + (Warning 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 [] @@ -495,6 +517,20 @@ module CustomAttributes_AttributeUsage = (Warning 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 + [] + let ``Preview: E_AttributeTargetIsField03_fs opt-in warning`` compilation = + compilation + |> withLangVersionPreview + |> withWarnOn 3878 + |> verifyCompile + |> shouldFail + |> withDiagnostics [ + (Warning 842, Line 14, Col 5, Line 14, Col 15, "This attribute is not valid for use on this language element"); + (Warning 3878, Line 14, Col 18, Line 14, Col 23, "This attribute is not valid for use on union cases with fields."); + (Warning 3878, Line 15, Col 28, Line 15, Col 33, "This attribute is not valid for use on union cases with fields.") + ] + // SOURCE=E_AttributeTargetIsProperty01.fs # E_AttributeTargetIsField03.fs [] let ``E_AttributeTargetIsProperty01_fs 8_0`` compilation = From 40b8196653edf63eb3807c38ab8bdf862a557193 Mon Sep 17 00:00:00 2001 From: Edgar Gonzalez Date: Sat, 17 May 2025 23:57:48 +0100 Subject: [PATCH 7/9] extract ResolveAttributeType and CheckAttributeUsage --- .../Checking/Expressions/CheckExpressions.fs | 134 ++++++++++-------- .../Checking/Expressions/CheckExpressions.fsi | 2 + 2 files changed, 75 insertions(+), 61 deletions(-) diff --git a/src/Compiler/Checking/Expressions/CheckExpressions.fs b/src/Compiler/Checking/Expressions/CheckExpressions.fs index 567e1da0310..b3c5d76e878 100644 --- a/src/Compiler/Checking/Expressions/CheckExpressions.fs +++ b/src/Compiler/Checking/Expressions/CheckExpressions.fs @@ -11288,6 +11288,75 @@ and TcNonRecursiveBinding declKind cenv env tpenv ty binding = let explicitTyparInfo, tpenv = TcNonrecBindingTyparDecls cenv env tpenv binding TcNormalizedBinding declKind cenv env tpenv ty None NoSafeInitInfo ([], explicitTyparInfo) binding +and ResolveAttributeType (cenv: cenv) (env: TcEnv) (mAttr: range) (tycon: Ident list) = + let tpenv = emptyUnscopedTyparEnv + let ad = env.eAccessRights + + let tyPath, tyId = List.frontAndBack tycon + + let try1 n = + let tyid = mkSynId tyId.idRange n + let tycon = (tyPath @ [tyid]) + + match ResolveTypeLongIdent cenv.tcSink cenv.nameResolver ItemOccurrence.UseInAttribute OpenQualified env.eNameResEnv ad tycon TypeNameResolutionStaticArgsInfo.DefiniteEmpty PermitDirectReferenceToGeneratedType.No with + | Exception err -> raze err + | Result(tinstEnclosing, tcref, inst) -> success(TcTypeApp cenv NoNewTypars CheckCxs ItemOccurrence.UseInAttribute env tpenv mAttr tcref tinstEnclosing [] inst) + + ForceRaise ((try1 (tyId.idText + "Attribute")) |> otherwise (fun () -> (try1 tyId.idText))) + +and CheckAttributeUsage (g: TcGlobals) (mAttr: range) (tcref: TyconRef) (attrTgt: AttributeTargets) (targetIndicator: Ident option) (attrEx: AttributeTargets) = + // REVIEW: take notice of inherited? + let validOn, _inherited = + let validOnDefault = 0x7fff + let inheritedDefault = true + if tcref.IsILTycon then + let tdef = tcref.ILTyconRawMetadata + let tref = g.attrib_AttributeUsageAttribute.TypeRef + + match TryDecodeILAttribute tref tdef.CustomAttrs with + | Some ([ILAttribElem.Int32 validOn ], named) -> + let inherited = + match List.tryPick (function "Inherited", _, _, ILAttribElem.Bool res -> Some res | _ -> None) named with + | None -> inheritedDefault + | Some x -> x + (validOn, inherited) + | Some ([ILAttribElem.Int32 validOn; ILAttribElem.Bool _allowMultiple; ILAttribElem.Bool inherited ], _) -> + (validOn, inherited) + | _ -> + (validOnDefault, inheritedDefault) + else + match (TryFindFSharpAttribute g g.attrib_AttributeUsageAttribute tcref.Attribs) with + | Some(Attrib(unnamedArgs = [ AttribInt32Arg validOn ])) -> + validOn, inheritedDefault + | Some(Attrib(unnamedArgs = [ AttribInt32Arg validOn; AttribBoolArg(_allowMultiple); AttribBoolArg inherited])) -> + validOn, inherited + | Some _ -> + warning(Error(FSComp.SR.tcUnexpectedConditionInImportedAssembly(), mAttr)) + validOnDefault, inheritedDefault + | _ -> + validOnDefault, inheritedDefault + + // Determine valid attribute targets + let attributeTargets = enum validOn &&& attrTgt + let directedTargets = + match targetIndicator with + | LongFormAttrTarget attrTarget -> attrTarget + | UnrecognizedLongAttrTarget attrTarget -> + errorR(Error(FSComp.SR.tcUnrecognizedAttributeTarget(), attrTarget.idRange)) + attributeTargets + | ShortFormAttributeTarget -> attributeTargets &&& ~~~ attrEx + + let constrainedTargets = attributeTargets &&& directedTargets + + // Check if attribute is valid for the target + if constrainedTargets = enum 0 then + if (directedTargets = AttributeTargets.Assembly || directedTargets = AttributeTargets.Module) then + errorR(Error(FSComp.SR.tcAttributeIsNotValidForLanguageElementUseDo(), mAttr)) + else + warning(Error(FSComp.SR.tcAttributeIsNotValidForLanguageElement(), mAttr)) + + constrainedTargets + //------------------------------------------------------------------------- // TcAttribute* // *Ex means the function accepts attribute targets that must be explicit @@ -11302,24 +11371,13 @@ and TcAttributeEx canFail (cenv: cenv) (env: TcEnv) attrTgt attrEx (synAttr: Syn let targetIndicator = synAttr.Target let isAppliedToGetterOrSetter = synAttr.AppliesToGetterAndSetter let mAttr = synAttr.Range - let typath, tyid = List.frontAndBack tycon - let tpenv = emptyUnscopedTyparEnv + let _, tyId = List.frontAndBack tycon let ad = env.eAccessRights // if we're checking an attribute that was applied directly to a getter or a setter, then // what we're really checking against is a method, not a property let attrTgt = if isAppliedToGetterOrSetter then ((attrTgt ^^^ AttributeTargets.Property) ||| AttributeTargets.Method) else attrTgt - let ty, tpenv = - let try1 n = - let tyid = mkSynId tyid.idRange n - let tycon = (typath @ [tyid]) - - match ResolveTypeLongIdent cenv.tcSink cenv.nameResolver ItemOccurrence.UseInAttribute OpenQualified env.eNameResEnv ad tycon TypeNameResolutionStaticArgsInfo.DefiniteEmpty PermitDirectReferenceToGeneratedType.No with - | Exception err -> raze err - | Result(tinstEnclosing, tcref, inst) -> success(TcTypeApp cenv NoNewTypars CheckCxs ItemOccurrence.UseInAttribute env tpenv mAttr tcref tinstEnclosing [] inst) - - ForceRaise ((try1 (tyid.idText + "Attribute")) |> otherwise (fun () -> (try1 tyid.idText))) - + let ty, tpenv = ResolveAttributeType cenv env mAttr tycon if not (IsTypeAccessible g cenv.amap mAttr ad ty) then errorR(Error(FSComp.SR.tcTypeIsInaccessible(), mAttr)) let tcref = tcrefOfAppTy g ty @@ -11330,53 +11388,7 @@ and TcAttributeEx canFail (cenv: cenv) (env: TcEnv) attrTgt attrEx (synAttr: Syn | Some d, Some defines when not (List.contains d defines) -> [], false | _ -> - // REVIEW: take notice of inherited? - let validOn, _inherited = - let validOnDefault = 0x7fff - let inheritedDefault = true - if tcref.IsILTycon then - let tdef = tcref.ILTyconRawMetadata - let tref = g.attrib_AttributeUsageAttribute.TypeRef - - match TryDecodeILAttribute tref tdef.CustomAttrs with - | Some ([ILAttribElem.Int32 validOn ], named) -> - let inherited = - match List.tryPick (function "Inherited", _, _, ILAttribElem.Bool res -> Some res | _ -> None) named with - | None -> inheritedDefault - | Some x -> x - (validOn, inherited) - | Some ([ILAttribElem.Int32 validOn; ILAttribElem.Bool _allowMultiple; ILAttribElem.Bool inherited ], _) -> - (validOn, inherited) - | _ -> - (validOnDefault, inheritedDefault) - else - match (TryFindFSharpAttribute g g.attrib_AttributeUsageAttribute tcref.Attribs) with - | Some(Attrib(_, _, [ AttribInt32Arg validOn ], _, _, _, _)) -> - (validOn, inheritedDefault) - | Some(Attrib(_, _, [ AttribInt32Arg validOn - AttribBoolArg(_allowMultiple) - AttribBoolArg inherited], _, _, _, _)) -> - (validOn, inherited) - | Some _ -> - warning(Error(FSComp.SR.tcUnexpectedConditionInImportedAssembly(), mAttr)) - (validOnDefault, inheritedDefault) - | _ -> - (validOnDefault, inheritedDefault) - let attributeTargets = enum validOn &&& attrTgt - let directedTargets = - match targetIndicator with - | LongFormAttrTarget attrTarget -> attrTarget - | UnrecognizedLongAttrTarget attrTarget -> - errorR(Error(FSComp.SR.tcUnrecognizedAttributeTarget(), attrTarget.idRange)) - attributeTargets - | ShortFormAttributeTarget -> attributeTargets &&& ~~~ attrEx - - let constrainedTargets = attributeTargets &&& directedTargets - if constrainedTargets = enum 0 then - if (directedTargets = AttributeTargets.Assembly || directedTargets = AttributeTargets.Module) then - error(Error(FSComp.SR.tcAttributeIsNotValidForLanguageElementUseDo(), mAttr)) - else - warning(Error(FSComp.SR.tcAttributeIsNotValidForLanguageElement(), mAttr)) + let constrainedTargets = CheckAttributeUsage g mAttr tcref attrTgt targetIndicator attrEx match ResolveObjectConstructor cenv.nameResolver env.DisplayEnv mAttr ad ty with | Exception _ when canFail = TcCanFail.IgnoreAllErrors || canFail = TcCanFail.IgnoreMemberResoutionError -> [ ], true @@ -11391,7 +11403,7 @@ and TcAttributeEx canFail (cenv: cenv) (env: TcEnv) attrTgt attrEx (synAttr: Syn match item with | Item.CtorGroup(methodName, minfos) -> let meths = minfos |> List.map (fun minfo -> minfo, None) - let afterResolution = ForNewConstructors cenv.tcSink env tyid.idRange methodName minfos + let afterResolution = ForNewConstructors cenv.tcSink env tyId.idRange methodName minfos let (expr, attributeAssignedNamedItems, _), _ = TcMethodApplication true cenv env tpenv None [] mAttr mAttr methodName None ad PossiblyMutates false meths afterResolution NormalValUse [arg] (MustEqual ty) None [] diff --git a/src/Compiler/Checking/Expressions/CheckExpressions.fsi b/src/Compiler/Checking/Expressions/CheckExpressions.fsi index ed18b07a58a..5992a4afc95 100644 --- a/src/Compiler/Checking/Expressions/CheckExpressions.fsi +++ b/src/Compiler/Checking/Expressions/CheckExpressions.fsi @@ -955,6 +955,8 @@ module AttributeTargets = val FieldDeclRestricted: AttributeTargets /// The allowed attribute targets for an F# union case declaration + /// - AttributeTargets.Method: union case with fields + /// - AttributeTargets.Property: union case with no fields val UnionCaseDecl: AttributeTargets /// The allowed attribute targets for an F# type declaration From 7060ff81bd9bed5fc2cbccf8b01e18fe8c156c72 Mon Sep 17 00:00:00 2001 From: edgargonzalez Date: Wed, 21 May 2025 13:08:03 +0100 Subject: [PATCH 8/9] use bit-logic to check if the bit for Method is set --- src/Compiler/Checking/CheckDeclarations.fs | 8 +++++--- 1 file changed, 5 insertions(+), 3 deletions(-) diff --git a/src/Compiler/Checking/CheckDeclarations.fs b/src/Compiler/Checking/CheckDeclarations.fs index 7c87c7efd0d..e984fd32f97 100644 --- a/src/Compiler/Checking/CheckDeclarations.fs +++ b/src/Compiler/Checking/CheckDeclarations.fs @@ -600,9 +600,11 @@ module TcRecdUnionAndEnumDeclarations = 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 target - if targetEnum <> AttributeTargets.Method && targetEnum <> AttributeTargets.All then - warning(Error(FSComp.SR.tcAttributeIsNotValidForUnionCaseWithFields(), id.idRange))) + let targetEnum = enum target + let hasMethodTarget = (targetEnum &&& AttributeTargets.Method) = AttributeTargets.Method + let hasAllTarget = (targetEnum &&& AttributeTargets.All) = AttributeTargets.All + if not (hasMethodTarget || hasAllTarget) then + warning(Error(FSComp.SR.tcAttributeIsNotValidForUnionCaseWithFields(), id.idRange))) Construct.NewUnionCase id rfields recordTy attrs xmlDoc vis From a33c433051ced664167400a4c74e1b6da86970c0 Mon Sep 17 00:00:00 2001 From: edgargonzalez Date: Thu, 22 May 2025 13:29:37 +0100 Subject: [PATCH 9/9] PR feedback --- src/Compiler/Checking/CheckDeclarations.fs | 8 +++----- 1 file changed, 3 insertions(+), 5 deletions(-) diff --git a/src/Compiler/Checking/CheckDeclarations.fs b/src/Compiler/Checking/CheckDeclarations.fs index e984fd32f97..1877e892f4f 100644 --- a/src/Compiler/Checking/CheckDeclarations.fs +++ b/src/Compiler/Checking/CheckDeclarations.fs @@ -600,11 +600,9 @@ module TcRecdUnionAndEnumDeclarations = 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 target - let hasMethodTarget = (targetEnum &&& AttributeTargets.Method) = AttributeTargets.Method - let hasAllTarget = (targetEnum &&& AttributeTargets.All) = AttributeTargets.All - if not (hasMethodTarget || hasAllTarget) then - warning(Error(FSComp.SR.tcAttributeIsNotValidForUnionCaseWithFields(), id.idRange))) + let hasNotMethodTarget = (enum target &&& AttributeTargets.Method) = enum 0 + if hasNotMethodTarget then + warning(Error(FSComp.SR.tcAttributeIsNotValidForUnionCaseWithFields(), id.idRange))) Construct.NewUnionCase id rfields recordTy attrs xmlDoc vis