From 1d2877eae54befdbb2908fd3a286a26f9284c6c0 Mon Sep 17 00:00:00 2001 From: Edgar Gonzalez Date: Tue, 27 Sep 2022 18:09:24 +0200 Subject: [PATCH 1/2] Compiler ignores obsolete attribute for enum cases --- src/Compiler/Checking/CheckDeclarations.fs | 6 ++-- .../ObsoleteAttributeCheckingTests.fs | 34 +++++++++++++++---- 2 files changed, 31 insertions(+), 9 deletions(-) diff --git a/src/Compiler/Checking/CheckDeclarations.fs b/src/Compiler/Checking/CheckDeclarations.fs index 1081998708b..60922f975b5 100644 --- a/src/Compiler/Checking/CheckDeclarations.fs +++ b/src/Compiler/Checking/CheckDeclarations.fs @@ -543,8 +543,9 @@ module TcRecdUnionAndEnumDeclarations = let unionCasesR = unionCases |> List.map (TcUnionCaseDecl cenv env parent thisTy thisTyInst tpenv hasRQAAttribute) unionCasesR |> CheckDuplicates (fun uc -> uc.Id) "union case" - let TcEnumDecl cenv env parent thisTy fieldTy (SynEnumCase(attributes=Attributes synAttrs; ident= SynIdent(id,_); value=v; xmlDoc=xmldoc; range=m)) = + let TcEnumDecl g cenv env parent thisTy fieldTy (SynEnumCase(attributes=Attributes synAttrs; ident= SynIdent(id,_); value=v; xmlDoc=xmldoc; range=m)) = let attrs = TcAttributes cenv env AttributeTargets.Field synAttrs + match v with | SynConst.Bytes _ | SynConst.UInt16s _ @@ -555,12 +556,13 @@ module TcRecdUnionAndEnumDeclarations = let vis = CombineReprAccess parent vis if id.idText = "value__" then errorR(Error(FSComp.SR.tcNotValidEnumCaseName(), id.idRange)) let xmlDoc = xmldoc.ToXmlDoc(true, Some []) + CheckFSharpAttributes g attrs m |> CommitOperationResult Construct.NewRecdField true (Some v) id false thisTy false false [] attrs xmlDoc vis false let TcEnumDecls (cenv: cenv) env parent thisTy enumCases = let g = cenv.g let fieldTy = NewInferenceType g - let enumCases' = enumCases |> List.map (TcEnumDecl cenv env parent thisTy fieldTy) |> CheckDuplicates (fun f -> f.Id) "enum element" + let enumCases' = enumCases |> List.map (TcEnumDecl g cenv env parent thisTy fieldTy) |> CheckDuplicates (fun f -> f.Id) "enum element" fieldTy, enumCases' //------------------------------------------------------------------------- diff --git a/tests/FSharp.Compiler.ComponentTests/Language/ObsoleteAttributeCheckingTests.fs b/tests/FSharp.Compiler.ComponentTests/Language/ObsoleteAttributeCheckingTests.fs index c2fa57509fc..c03fd5e0182 100644 --- a/tests/FSharp.Compiler.ComponentTests/Language/ObsoleteAttributeCheckingTests.fs +++ b/tests/FSharp.Compiler.ComponentTests/Language/ObsoleteAttributeCheckingTests.fs @@ -206,9 +206,9 @@ C.Update() |> withDiagnostics [ (Error 101, Line 9, Col 1, Line 9, Col 9, "This construct is deprecated. Use B instead") ] - + [] - let ``Obsolete attribute is taken into account when used on an enum and invocation`` () = + let ``Obsolete attribute error is taken into account when used on an enum and invocation`` () = Fsx """ open System @@ -219,15 +219,14 @@ type Color = let c = Color.Red """ - |> ignoreWarnings |> compile |> shouldFail |> withDiagnostics [ (Error 101, Line 9, Col 9, Line 9, Col 14, "This construct is deprecated. Use B instead") ] - + [] - let ``Obsolete attribute is taken into account when used on an enum entry and invocation`` () = + let ``Obsolete attribute error is taken into account when used on an enum field and invocation`` () = Fsx """ open System @@ -237,9 +236,30 @@ type Color = let c = Color.Red """ - |> ignoreWarnings |> compile - |> shouldSucceed + |> shouldFail + |> withDiagnostics [ + (Error 101, Line 5, Col 7, Line 5, Col 50, "This construct is deprecated. Use B instead") + // FIXME Find the reason why we are getting this new compiler error + (Error 39, Line 8, Col 15, Line 8, Col 18, "The type 'Color' does not define the field, constructor or member 'Red'.") + ] + + [] + let ``Obsolete attribute warning is taken into account when used on an enum field and invocation`` () = + Fsx """ +open System + +type Color = + | [] Red = 0 + | Green = 1 + +let c = Color.Red + """ + |> compile + |> shouldFail + |> withDiagnostics [ + (Warning 44, Line 5, Col 7, Line 5, Col 44, "This construct is deprecated. Use B instead") + ] [] let ``Obsolete attribute is taken into account when used on an type and use extension method`` () = From 31198227d4d53c70046277ad0806b7a4cd122011 Mon Sep 17 00:00:00 2001 From: Edgar Gonzalez Date: Thu, 29 Sep 2022 20:30:33 +0200 Subject: [PATCH 2/2] Update CheckRecdFieldAttributes to use FieldAttribs --- src/Compiler/Checking/AttributeChecking.fs | 3 ++- src/Compiler/Checking/CheckDeclarations.fs | 5 ++--- .../Language/ObsoleteAttributeCheckingTests.fs | 6 ++---- 3 files changed, 6 insertions(+), 8 deletions(-) diff --git a/src/Compiler/Checking/AttributeChecking.fs b/src/Compiler/Checking/AttributeChecking.fs index d1d50393523..82f504865ab 100644 --- a/src/Compiler/Checking/AttributeChecking.fs +++ b/src/Compiler/Checking/AttributeChecking.fs @@ -507,7 +507,8 @@ let CheckUnionCaseAttributes g (x:UnionCaseRef) m = /// Check the attributes on a record field, returning errors and warnings as data. let CheckRecdFieldAttributes g (x:RecdFieldRef) m = CheckEntityAttributes g x.TyconRef m ++ (fun () -> - CheckFSharpAttributes g x.PropertyAttribs m) + CheckFSharpAttributes g x.PropertyAttribs m) ++ (fun () -> + CheckFSharpAttributes g x.RecdField.FieldAttribs m) /// Check the attributes on an F# value, returning errors and warnings as data. let CheckValAttributes g (x:ValRef) m = diff --git a/src/Compiler/Checking/CheckDeclarations.fs b/src/Compiler/Checking/CheckDeclarations.fs index 60922f975b5..ac0080ca829 100644 --- a/src/Compiler/Checking/CheckDeclarations.fs +++ b/src/Compiler/Checking/CheckDeclarations.fs @@ -543,7 +543,7 @@ module TcRecdUnionAndEnumDeclarations = let unionCasesR = unionCases |> List.map (TcUnionCaseDecl cenv env parent thisTy thisTyInst tpenv hasRQAAttribute) unionCasesR |> CheckDuplicates (fun uc -> uc.Id) "union case" - let TcEnumDecl g cenv env parent thisTy fieldTy (SynEnumCase(attributes=Attributes synAttrs; ident= SynIdent(id,_); value=v; xmlDoc=xmldoc; range=m)) = + let TcEnumDecl cenv env parent thisTy fieldTy (SynEnumCase(attributes=Attributes synAttrs; ident= SynIdent(id,_); value=v; xmlDoc=xmldoc; range=m)) = let attrs = TcAttributes cenv env AttributeTargets.Field synAttrs match v with @@ -556,13 +556,12 @@ module TcRecdUnionAndEnumDeclarations = let vis = CombineReprAccess parent vis if id.idText = "value__" then errorR(Error(FSComp.SR.tcNotValidEnumCaseName(), id.idRange)) let xmlDoc = xmldoc.ToXmlDoc(true, Some []) - CheckFSharpAttributes g attrs m |> CommitOperationResult Construct.NewRecdField true (Some v) id false thisTy false false [] attrs xmlDoc vis false let TcEnumDecls (cenv: cenv) env parent thisTy enumCases = let g = cenv.g let fieldTy = NewInferenceType g - let enumCases' = enumCases |> List.map (TcEnumDecl g cenv env parent thisTy fieldTy) |> CheckDuplicates (fun f -> f.Id) "enum element" + let enumCases' = enumCases |> List.map (TcEnumDecl cenv env parent thisTy fieldTy) |> CheckDuplicates (fun f -> f.Id) "enum element" fieldTy, enumCases' //------------------------------------------------------------------------- diff --git a/tests/FSharp.Compiler.ComponentTests/Language/ObsoleteAttributeCheckingTests.fs b/tests/FSharp.Compiler.ComponentTests/Language/ObsoleteAttributeCheckingTests.fs index c03fd5e0182..29ea071835f 100644 --- a/tests/FSharp.Compiler.ComponentTests/Language/ObsoleteAttributeCheckingTests.fs +++ b/tests/FSharp.Compiler.ComponentTests/Language/ObsoleteAttributeCheckingTests.fs @@ -239,9 +239,7 @@ let c = Color.Red |> compile |> shouldFail |> withDiagnostics [ - (Error 101, Line 5, Col 7, Line 5, Col 50, "This construct is deprecated. Use B instead") - // FIXME Find the reason why we are getting this new compiler error - (Error 39, Line 8, Col 15, Line 8, Col 18, "The type 'Color' does not define the field, constructor or member 'Red'.") + (Error 101, Line 8, Col 9, Line 8, Col 18, "This construct is deprecated. Use B instead") ] [] @@ -258,7 +256,7 @@ let c = Color.Red |> compile |> shouldFail |> withDiagnostics [ - (Warning 44, Line 5, Col 7, Line 5, Col 44, "This construct is deprecated. Use B instead") + (Warning 44, Line 8, Col 9, Line 8, Col 18, "This construct is deprecated. Use B instead") ] []