From 925f0339d0e4ce3d31867fd5db130691704b3fe3 Mon Sep 17 00:00:00 2001 From: Edgar Gonzalez Date: Mon, 11 Mar 2024 12:05:49 +0000 Subject: [PATCH 01/12] Obsolete attribute is ignored in constructor property assignment --- src/Compiler/Checking/CheckExpressions.fs | 5 +++++ .../Language/ObsoleteAttributeCheckingTests.fs | 16 ++++++++++++++++ 2 files changed, 21 insertions(+) diff --git a/src/Compiler/Checking/CheckExpressions.fs b/src/Compiler/Checking/CheckExpressions.fs index 220e4da4c82..dcc22406262 100644 --- a/src/Compiler/Checking/CheckExpressions.fs +++ b/src/Compiler/Checking/CheckExpressions.fs @@ -6656,6 +6656,11 @@ and TcCtorCall isNaked cenv env tpenv (overallTy: OverallTy) objTy mObjTyOpt ite if isNaked && TypeFeasiblySubsumesType 0 g cenv.amap mWholeCall g.system_IDisposable_ty NoCoerce objTy then warning(Error(FSComp.SR.tcIDisposableTypeShouldUseNew(), mWholeCall)) + let valRefs = minfos |> List.collect (fun minfo -> minfo.ApparentEnclosingTyconRef.MembersOfFSharpTyconSorted) + + for valRef in valRefs do + CheckValAttributes g valRef mItem |> CommitOperationResult + // Check the type is not abstract // skip this check if this ctor call is either 'inherit(...)' or call is located within constructor shape if not (superInit || AreWithinCtorShape env) diff --git a/tests/FSharp.Compiler.ComponentTests/Language/ObsoleteAttributeCheckingTests.fs b/tests/FSharp.Compiler.ComponentTests/Language/ObsoleteAttributeCheckingTests.fs index d503daa77e0..e7e7e7d9e05 100644 --- a/tests/FSharp.Compiler.ComponentTests/Language/ObsoleteAttributeCheckingTests.fs +++ b/tests/FSharp.Compiler.ComponentTests/Language/ObsoleteAttributeCheckingTests.fs @@ -1262,3 +1262,19 @@ let f (x: IFirst) = x.F() (Error 101, Line 13, Col 11, Line 13, Col 17, "This construct is deprecated. Use G instead") (Error 72, Line 13, Col 21, Line 13, Col 24, "Lookup on object of indeterminate type based on information prior to this program point. A type annotation may be needed prior to this program point to constrain the type of the object. This may allow the lookup to be resolved.") ] + + [] + let ``Obsolete attribute is ignored in constructor property assignment`` () = + Fsx """ +open System +type JsonSerializerOptions() = + [] + member val DefaultOptions = false with get, set + +let options = JsonSerializerOptions(DefaultOptions = true) + """ + |> ignoreWarnings + |> typecheck + |> shouldFail + |> withDiagnostics [ + ] \ No newline at end of file From a5f80320f3a3bef2bbdd55d11a81257ccdb00629 Mon Sep 17 00:00:00 2001 From: Edgar Gonzalez Date: Mon, 11 Mar 2024 14:26:29 +0000 Subject: [PATCH 02/12] Raise an warning when Obsolete attribute is used in constructor property assignment. --- src/Compiler/Checking/CheckExpressions.fs | 23 +++++++++++++++---- .../ObsoleteAttributeCheckingTests.fs | 7 +++--- 2 files changed, 22 insertions(+), 8 deletions(-) diff --git a/src/Compiler/Checking/CheckExpressions.fs b/src/Compiler/Checking/CheckExpressions.fs index dcc22406262..6738d2f8769 100644 --- a/src/Compiler/Checking/CheckExpressions.fs +++ b/src/Compiler/Checking/CheckExpressions.fs @@ -6649,17 +6649,30 @@ and TcCtorCall isNaked cenv env tpenv (overallTy: OverallTy) objTy mObjTyOpt ite if isInterfaceTy g objTy then error(Error((if superInit then FSComp.SR.tcInheritCannotBeUsedOnInterfaceType() else FSComp.SR.tcNewCannotBeUsedOnInterfaceType()), mWholeCall)) + + let rec getConstructorArgs expr = + match expr with + | SynExpr.Paren(expr = SynExpr.App(funcExpr = expr)) -> + getConstructorArgs expr + | SynExpr.Paren(expr = SynExpr.Tuple(exprs = synExprs)) -> + synExprs + |> List.collect getConstructorArgs + | SynExpr.App(funcExpr = expr1; argExpr = expr2) -> + getConstructorArgs expr1 @ getConstructorArgs expr2 + | SynExpr.Ident(id) -> [id] + | _ -> [] match item, args with - | Item.CtorGroup(methodName, minfos), _ -> + | Item.CtorGroup(methodName, minfos), exprArgs -> let meths = List.map (fun minfo -> minfo, None) minfos if isNaked && TypeFeasiblySubsumesType 0 g cenv.amap mWholeCall g.system_IDisposable_ty NoCoerce objTy then warning(Error(FSComp.SR.tcIDisposableTypeShouldUseNew(), mWholeCall)) - let valRefs = minfos |> List.collect (fun minfo -> minfo.ApparentEnclosingTyconRef.MembersOfFSharpTyconSorted) - - for valRef in valRefs do - CheckValAttributes g valRef mItem |> CommitOperationResult + let ctorArgs = exprArgs |> List.collect getConstructorArgs + + if not ctorArgs.IsEmpty then + for valRef in valRefs do + CheckValAttributes g valRef mItem |> CommitOperationResult // Check the type is not abstract // skip this check if this ctor call is either 'inherit(...)' or call is located within constructor shape diff --git a/tests/FSharp.Compiler.ComponentTests/Language/ObsoleteAttributeCheckingTests.fs b/tests/FSharp.Compiler.ComponentTests/Language/ObsoleteAttributeCheckingTests.fs index e7e7e7d9e05..247614990dd 100644 --- a/tests/FSharp.Compiler.ComponentTests/Language/ObsoleteAttributeCheckingTests.fs +++ b/tests/FSharp.Compiler.ComponentTests/Language/ObsoleteAttributeCheckingTests.fs @@ -1264,16 +1264,17 @@ let f (x: IFirst) = x.F() ] [] - let ``Obsolete attribute is ignored in constructor property assignment`` () = + let ``Obsolete attribute warning is taken into account in a constructor property assigment`` () = Fsx """ open System type JsonSerializerOptions() = [] member val DefaultOptions = false with get, set -let options = JsonSerializerOptions(DefaultOptions = true) + member val UseCustomOptions = false with get, set + +let options = JsonSerializerOptions(DefaultOptions = true, UseCustomOptions = false) """ - |> ignoreWarnings |> typecheck |> shouldFail |> withDiagnostics [ From 4558fffe1775ede6713aca6cfed9cb76d2c6167a Mon Sep 17 00:00:00 2001 From: Edgar Gonzalez Date: Thu, 21 Mar 2024 18:21:22 +0000 Subject: [PATCH 03/12] release notes --- docs/release-notes/.FSharp.Compiler.Service/8.0.300.md | 1 + 1 file changed, 1 insertion(+) diff --git a/docs/release-notes/.FSharp.Compiler.Service/8.0.300.md b/docs/release-notes/.FSharp.Compiler.Service/8.0.300.md index b5a86a6540f..8e88853da2b 100644 --- a/docs/release-notes/.FSharp.Compiler.Service/8.0.300.md +++ b/docs/release-notes/.FSharp.Compiler.Service/8.0.300.md @@ -23,6 +23,7 @@ * Enforce AttributeTargets on enums ([PR #16887](https://github.com/dotnet/fsharp/pull/16887)) * Completion: fix for unfinished record field decl ([PR #16893](https://github.com/dotnet/fsharp/pull/16893)) * Enforce AttributeTargets on delegates ([PR #16891](https://github.com/dotnet/fsharp/pull/16891)) +* Obsolete attribute is ignored in constructor property assignment. ([PR #16900](https://github.com/dotnet/fsharp/pull/16900)) ### Added From aa1c61e06eee1651b95c44c6623b2fd9b21e5d95 Mon Sep 17 00:00:00 2001 From: Edgar Gonzalez Date: Mon, 25 Mar 2024 15:11:21 +0000 Subject: [PATCH 04/12] Use a more accuarate range --- src/Compiler/Checking/CheckExpressions.fs | 23 ++++++++------ .../ObsoleteAttributeCheckingTests.fs | 31 +++++++++++++++++-- 2 files changed, 41 insertions(+), 13 deletions(-) diff --git a/src/Compiler/Checking/CheckExpressions.fs b/src/Compiler/Checking/CheckExpressions.fs index 6738d2f8769..4711a6928f0 100644 --- a/src/Compiler/Checking/CheckExpressions.fs +++ b/src/Compiler/Checking/CheckExpressions.fs @@ -6655,24 +6655,27 @@ and TcCtorCall isNaked cenv env tpenv (overallTy: OverallTy) objTy mObjTyOpt ite | SynExpr.Paren(expr = SynExpr.App(funcExpr = expr)) -> getConstructorArgs expr | SynExpr.Paren(expr = SynExpr.Tuple(exprs = synExprs)) -> - synExprs - |> List.collect getConstructorArgs + synExprs |> List.collect getConstructorArgs | SynExpr.App(funcExpr = expr1; argExpr = expr2) -> getConstructorArgs expr1 @ getConstructorArgs expr2 - | SynExpr.Ident(id) -> [id] + | SynExpr.Ident(id) -> [ id ] | _ -> [] match item, args with - | Item.CtorGroup(methodName, minfos), exprArgs -> + | Item.CtorGroup(methodName, minfos), argExprs -> let meths = List.map (fun minfo -> minfo, None) minfos if isNaked && TypeFeasiblySubsumesType 0 g cenv.amap mWholeCall g.system_IDisposable_ty NoCoerce objTy then warning(Error(FSComp.SR.tcIDisposableTypeShouldUseNew(), mWholeCall)) - let valRefs = minfos |> List.collect (fun minfo -> minfo.ApparentEnclosingTyconRef.MembersOfFSharpTyconSorted) - let ctorArgs = exprArgs |> List.collect getConstructorArgs - - if not ctorArgs.IsEmpty then - for valRef in valRefs do - CheckValAttributes g valRef mItem |> CommitOperationResult + + let valRefs = + minfos + |> List.collect (fun minfo-> minfo.ApparentEnclosingTyconRef.MembersOfFSharpTyconSorted) + |> List.filter (fun v -> CheckFSharpAttributesForObsolete g v.Attribs) + for vref in valRefs do + let ctorArgs = argExprs |> List.collect getConstructorArgs + for arg in ctorArgs do + if arg.idText = vref.DisplayName then + CheckValAttributes g vref arg.idRange |> CommitOperationResult // Check the type is not abstract // skip this check if this ctor call is either 'inherit(...)' or call is located within constructor shape diff --git a/tests/FSharp.Compiler.ComponentTests/Language/ObsoleteAttributeCheckingTests.fs b/tests/FSharp.Compiler.ComponentTests/Language/ObsoleteAttributeCheckingTests.fs index 247614990dd..3c34279a036 100644 --- a/tests/FSharp.Compiler.ComponentTests/Language/ObsoleteAttributeCheckingTests.fs +++ b/tests/FSharp.Compiler.ComponentTests/Language/ObsoleteAttributeCheckingTests.fs @@ -1262,9 +1262,9 @@ let f (x: IFirst) = x.F() (Error 101, Line 13, Col 11, Line 13, Col 17, "This construct is deprecated. Use G instead") (Error 72, Line 13, Col 21, Line 13, Col 24, "Lookup on object of indeterminate type based on information prior to this program point. A type annotation may be needed prior to this program point to constrain the type of the object. This may allow the lookup to be resolved.") ] - + [] - let ``Obsolete attribute warning is taken into account in a constructor property assigment`` () = + let ``Obsolete attribute warning is taken into account in a constructor property assignment`` () = Fsx """ open System type JsonSerializerOptions() = @@ -1274,8 +1274,33 @@ type JsonSerializerOptions() = member val UseCustomOptions = false with get, set let options = JsonSerializerOptions(DefaultOptions = true, UseCustomOptions = false) +let options2 = JsonSerializerOptions(DefaultOptions = true, DefaultOptions = false) + """ + |> typecheck + |> shouldFail + |> withDiagnostics [ + (Warning 44, Line 9, Col 37, Line 9, Col 51, "This construct is deprecated. This is bad") + (Warning 44, Line 10, Col 38, Line 10, Col 52, "This construct is deprecated. This is bad") + (Warning 44, Line 10, Col 61, Line 10, Col 75, "This construct is deprecated. This is bad") + (Error 364, Line 10, Col 16, Line 10, Col 84, "The named argument 'DefaultOptions' has been assigned more than one value") + ] + + [] + let ``Obsolete attribute error is taken into account in a constructor property assignment`` () = + Fsx """ +open System +type JsonSerializerOptions() = + [] + member val DefaultOptions = false with get, set + + member val UseCustomOptions = false with get, set + +let options = JsonSerializerOptions(DefaultOptions = true, UseCustomOptions = false) +let options2 = JsonSerializerOptions(DefaultOptions = true, DefaultOptions = false) """ |> typecheck |> shouldFail |> withDiagnostics [ - ] \ No newline at end of file + (Error 101, Line 9, Col 37, Line 9, Col 51, "This construct is deprecated. This is bad") + (Error 101, Line 10, Col 38, Line 10, Col 52, "This construct is deprecated. This is bad") + ] \ No newline at end of file From 93a0f1abe1f0183ee9bfa8f8feaf32a94a218c0b Mon Sep 17 00:00:00 2001 From: Edgar Gonzalez Date: Mon, 25 Mar 2024 19:22:00 +0000 Subject: [PATCH 05/12] GetImmediateIntrinsicPropInfosOfType --- src/Compiler/Checking/CheckExpressions.fs | 19 ++++++++++++++++-- .../ObsoleteAttributeCheckingTests.fs | 20 ++++++++++++++++--- 2 files changed, 34 insertions(+), 5 deletions(-) diff --git a/src/Compiler/Checking/CheckExpressions.fs b/src/Compiler/Checking/CheckExpressions.fs index 4711a6928f0..0326fdaea20 100644 --- a/src/Compiler/Checking/CheckExpressions.fs +++ b/src/Compiler/Checking/CheckExpressions.fs @@ -6666,17 +6666,32 @@ and TcCtorCall isNaked cenv env tpenv (overallTy: OverallTy) objTy mObjTyOpt ite let meths = List.map (fun minfo -> minfo, None) minfos if isNaked && TypeFeasiblySubsumesType 0 g cenv.amap mWholeCall g.system_IDisposable_ty NoCoerce objTy then warning(Error(FSComp.SR.tcIDisposableTypeShouldUseNew(), mWholeCall)) - + + let ctorArgs = argExprs |> List.collect getConstructorArgs + let valRefs = minfos |> List.collect (fun minfo-> minfo.ApparentEnclosingTyconRef.MembersOfFSharpTyconSorted) |> List.filter (fun v -> CheckFSharpAttributesForObsolete g v.Attribs) + for vref in valRefs do - let ctorArgs = argExprs |> List.collect getConstructorArgs for arg in ctorArgs do if arg.idText = vref.DisplayName then CheckValAttributes g vref arg.idRange |> CommitOperationResult + let propInfos = + [ + for minfo in minfos do + if not (TryFindILAttribute g.attrib_SystemObsolete (minfo.GetCustomAttrs())) then + GetImmediateIntrinsicPropInfosOfType (None, AccessibleFromSomeFSharpCode) g cenv.amap range0 minfo.ApparentEnclosingType + ] + |> List.collect id + + for propInfo in propInfos do + for arg in ctorArgs do + if arg.idText = propInfo.DisplayName then + CheckPropInfoAttributes propInfo arg.idRange |> CommitOperationResult + // Check the type is not abstract // skip this check if this ctor call is either 'inherit(...)' or call is located within constructor shape if not (superInit || AreWithinCtorShape env) diff --git a/tests/FSharp.Compiler.ComponentTests/Language/ObsoleteAttributeCheckingTests.fs b/tests/FSharp.Compiler.ComponentTests/Language/ObsoleteAttributeCheckingTests.fs index 3c34279a036..82bd23f5840 100644 --- a/tests/FSharp.Compiler.ComponentTests/Language/ObsoleteAttributeCheckingTests.fs +++ b/tests/FSharp.Compiler.ComponentTests/Language/ObsoleteAttributeCheckingTests.fs @@ -1262,7 +1262,7 @@ let f (x: IFirst) = x.F() (Error 101, Line 13, Col 11, Line 13, Col 17, "This construct is deprecated. Use G instead") (Error 72, Line 13, Col 21, Line 13, Col 24, "Lookup on object of indeterminate type based on information prior to this program point. A type annotation may be needed prior to this program point to constrain the type of the object. This may allow the lookup to be resolved.") ] - + [] let ``Obsolete attribute warning is taken into account in a constructor property assignment`` () = Fsx """ @@ -1284,7 +1284,7 @@ let options2 = JsonSerializerOptions(DefaultOptions = true, DefaultOptions = fal (Warning 44, Line 10, Col 61, Line 10, Col 75, "This construct is deprecated. This is bad") (Error 364, Line 10, Col 16, Line 10, Col 84, "The named argument 'DefaultOptions' has been assigned more than one value") ] - + [] let ``Obsolete attribute error is taken into account in a constructor property assignment`` () = Fsx """ @@ -1303,4 +1303,18 @@ let options2 = JsonSerializerOptions(DefaultOptions = true, DefaultOptions = fal |> withDiagnostics [ (Error 101, Line 9, Col 37, Line 9, Col 51, "This construct is deprecated. This is bad") (Error 101, Line 10, Col 38, Line 10, Col 52, "This construct is deprecated. This is bad") - ] \ No newline at end of file + ] + + [] + let ``Obsolete attribute is taken into account in a constructor property assignment`` () = + Fsx """ +open System.Text.Json + +let options = JsonSerializerOptions(JsonSerializerDefaults.Web, IgnoreNullValues = true) + """ + |> typecheck + |> shouldFail + |> withDiagnostics [ + (Warning 44, Line 4, Col 65, Line 4, Col 81, "This construct is deprecated. JsonSerializerOptions.IgnoreNullValues is obsolete. To ignore null values when serializing, set DefaultIgnoreCondition to JsonIgnoreCondition.WhenWritingNull.") + ] + \ No newline at end of file From ea5e73632284a11227dfc2b2422d8a2fa04903f8 Mon Sep 17 00:00:00 2001 From: Edgar Gonzalez Date: Mon, 25 Mar 2024 20:42:55 +0000 Subject: [PATCH 06/12] more tests --- .../ObsoleteAttributeCheckingTests.fs | 53 +++++++++++++++---- 1 file changed, 44 insertions(+), 9 deletions(-) diff --git a/tests/FSharp.Compiler.ComponentTests/Language/ObsoleteAttributeCheckingTests.fs b/tests/FSharp.Compiler.ComponentTests/Language/ObsoleteAttributeCheckingTests.fs index 82bd23f5840..da17dd15d3f 100644 --- a/tests/FSharp.Compiler.ComponentTests/Language/ObsoleteAttributeCheckingTests.fs +++ b/tests/FSharp.Compiler.ComponentTests/Language/ObsoleteAttributeCheckingTests.fs @@ -1,5 +1,6 @@ namespace Language +open FSharp.Test open Xunit open FSharp.Test.Compiler @@ -1304,17 +1305,51 @@ let options2 = JsonSerializerOptions(DefaultOptions = true, DefaultOptions = fal (Error 101, Line 9, Col 37, Line 9, Col 51, "This construct is deprecated. This is bad") (Error 101, Line 10, Col 38, Line 10, Col 52, "This construct is deprecated. This is bad") ] - + [] - let ``Obsolete attribute is taken into account in a constructor property assignment`` () = - Fsx """ -open System.Text.Json + let ``Obsolete attribute warning is taken into account in a constructor property assignment from a csharp class`` () = + let CSLib = + CSharp """ +using System; +public class JsonProtocolTestData { + [Obsolete("Use Json instead")] + public bool IgnoreNullValues { get; set; } +} + """ |> withName "CSLib" -let options = JsonSerializerOptions(JsonSerializerDefaults.Web, IgnoreNullValues = true) - """ - |> typecheck + let app = + FSharp """ +module ObsoleteStruct.FS +let res = JsonProtocolTestData(IgnoreNullValues = false) + """ |> withReferences [CSLib] + + app + |> compile |> shouldFail |> withDiagnostics [ - (Warning 44, Line 4, Col 65, Line 4, Col 81, "This construct is deprecated. JsonSerializerOptions.IgnoreNullValues is obsolete. To ignore null values when serializing, set DefaultIgnoreCondition to JsonIgnoreCondition.WhenWritingNull.") + (Warning 44, Line 3, Col 32, Line 3, Col 48, "This construct is deprecated. Use Json instead") ] - \ No newline at end of file + + [] + let ``Obsolete attribute error is taken into account in a constructor property assignment from a csharp class`` () = + let CSLib = + CSharp """ +using System; +public class JsonProtocolTestData { + [Obsolete("Use Json instead", true)] + public bool IgnoreNullValues { get; set; } +} + """ |> withName "CSLib" + + let app = + FSharp """ +module ObsoleteStruct.FS +let res = JsonProtocolTestData(IgnoreNullValues = false) + """ |> withReferences [CSLib] + + app + |> compile + |> shouldFail + |> withDiagnostics [ + (Error 101, Line 3, Col 32, Line 3, Col 48, "This construct is deprecated. Use Json instead") + ] \ No newline at end of file From 7655d245fdac648ca329f010da7b5c36cec73169 Mon Sep 17 00:00:00 2001 From: Edgar Gonzalez Date: Tue, 26 Mar 2024 09:48:33 +0000 Subject: [PATCH 07/12] more tests --- .../ObsoleteAttributeCheckingTests.fs | 47 +++++++++++++++++++ 1 file changed, 47 insertions(+) diff --git a/tests/FSharp.Compiler.ComponentTests/Language/ObsoleteAttributeCheckingTests.fs b/tests/FSharp.Compiler.ComponentTests/Language/ObsoleteAttributeCheckingTests.fs index da17dd15d3f..8ffa9618ab5 100644 --- a/tests/FSharp.Compiler.ComponentTests/Language/ObsoleteAttributeCheckingTests.fs +++ b/tests/FSharp.Compiler.ComponentTests/Language/ObsoleteAttributeCheckingTests.fs @@ -1305,6 +1305,53 @@ let options2 = JsonSerializerOptions(DefaultOptions = true, DefaultOptions = fal (Error 101, Line 9, Col 37, Line 9, Col 51, "This construct is deprecated. This is bad") (Error 101, Line 10, Col 38, Line 10, Col 52, "This construct is deprecated. This is bad") ] + + [] + let ``Obsolete attribute warning is taken into account in a nested constructor property assignment`` () = + Fsx """ +open System +type JsonSerializer1Options() = + [] + member val DefaultOptions = false with get, set + + member val UseCustomOptions = false with get, set + +type JsonSerializerOptions() = + member val DefaultOptions = JsonSerializer1Options() with get, set + + member val UseCustomOptions = false with get, set + +let options = JsonSerializerOptions(DefaultOptions = JsonSerializer1Options(DefaultOptions = true), UseCustomOptions = false) + """ + |> typecheck + |> shouldFail + |> withDiagnostics [ + (Warning 44, Line 14, Col 77, Line 14, Col 91, "This construct is deprecated. This is bad") + ] + + [] + let ``Obsolete attribute error is taken into account in a nested constructor property assignment`` () = + Fsx """ +open System +type JsonSerializer1Options() = + [] + member val DefaultOptions = false with get, set + + member val UseCustomOptions = false with get, set + +type JsonSerializerOptions() = + member val DefaultOptions = JsonSerializer1Options() with get, set + + member val UseCustomOptions = false with get, set + +let options = JsonSerializerOptions(DefaultOptions = JsonSerializer1Options(DefaultOptions = true), UseCustomOptions = false) + """ + |> typecheck + |> shouldFail + |> withDiagnostics [ + (Error 101, Line 14, Col 77, Line 14, Col 91, "This construct is deprecated. This is bad") + ] + [] let ``Obsolete attribute warning is taken into account in a constructor property assignment from a csharp class`` () = From f33f9226e42bda53ee931aefda03bebf2003603d Mon Sep 17 00:00:00 2001 From: Edgar Gonzalez Date: Tue, 26 Mar 2024 09:49:34 +0000 Subject: [PATCH 08/12] Update logic to check one case at the time --- src/Compiler/Checking/CheckExpressions.fs | 46 +++++++++++------------ 1 file changed, 23 insertions(+), 23 deletions(-) diff --git a/src/Compiler/Checking/CheckExpressions.fs b/src/Compiler/Checking/CheckExpressions.fs index 0326fdaea20..8e176c6d0a4 100644 --- a/src/Compiler/Checking/CheckExpressions.fs +++ b/src/Compiler/Checking/CheckExpressions.fs @@ -6668,29 +6668,29 @@ and TcCtorCall isNaked cenv env tpenv (overallTy: OverallTy) objTy mObjTyOpt ite warning(Error(FSComp.SR.tcIDisposableTypeShouldUseNew(), mWholeCall)) let ctorArgs = argExprs |> List.collect getConstructorArgs - - let valRefs = - minfos - |> List.collect (fun minfo-> minfo.ApparentEnclosingTyconRef.MembersOfFSharpTyconSorted) - |> List.filter (fun v -> CheckFSharpAttributesForObsolete g v.Attribs) - - for vref in valRefs do - for arg in ctorArgs do - if arg.idText = vref.DisplayName then - CheckValAttributes g vref arg.idRange |> CommitOperationResult - - let propInfos = - [ - for minfo in minfos do - if not (TryFindILAttribute g.attrib_SystemObsolete (minfo.GetCustomAttrs())) then - GetImmediateIntrinsicPropInfosOfType (None, AccessibleFromSomeFSharpCode) g cenv.amap range0 minfo.ApparentEnclosingType - ] - |> List.collect id - - for propInfo in propInfos do - for arg in ctorArgs do - if arg.idText = propInfo.DisplayName then - CheckPropInfoAttributes propInfo arg.idRange |> CommitOperationResult + + if not ctorArgs.IsEmpty then + // Here we will have the ValRefs(Members, Properties) from F# types + let valRefs = + minfos + |> List.collect (fun minfo-> minfo.ApparentEnclosingTyconRef.MembersOfFSharpTyconSorted) + |> List.filter (fun v -> CheckFSharpAttributesForObsolete g v.Attribs) + + if valRefs.IsEmpty then + // Here we will have the PropInfos from C# types + let propInfos = + minfos + |> List.collect (fun minfo -> GetImmediateIntrinsicPropInfosOfType (None, AccessibleFromSomeFSharpCode) g cenv.amap range0 minfo.ApparentEnclosingType) + + for propInfo in propInfos do + for arg in ctorArgs do + if arg.idText = propInfo.DisplayName then + CheckPropInfoAttributes propInfo arg.idRange |> CommitOperationResult + else + for vref in valRefs do + for arg in ctorArgs do + if arg.idText = vref.DisplayName then + CheckValAttributes g vref arg.idRange |> CommitOperationResult // Check the type is not abstract // skip this check if this ctor call is either 'inherit(...)' or call is located within constructor shape From 809ea70bbcc677d0ae65de46c4bfdcdb59d9ebca Mon Sep 17 00:00:00 2001 From: Edgar Gonzalez Date: Tue, 26 Mar 2024 12:13:39 +0000 Subject: [PATCH 09/12] getConstructorArgs --- src/Compiler/Checking/CheckExpressions.fs | 11 ++++------- .../Language/ObsoleteAttributeCheckingTests.fs | 3 +-- 2 files changed, 5 insertions(+), 9 deletions(-) diff --git a/src/Compiler/Checking/CheckExpressions.fs b/src/Compiler/Checking/CheckExpressions.fs index 8e176c6d0a4..5b50d34ccac 100644 --- a/src/Compiler/Checking/CheckExpressions.fs +++ b/src/Compiler/Checking/CheckExpressions.fs @@ -6649,15 +6649,12 @@ and TcCtorCall isNaked cenv env tpenv (overallTy: OverallTy) objTy mObjTyOpt ite if isInterfaceTy g objTy then error(Error((if superInit then FSComp.SR.tcInheritCannotBeUsedOnInterfaceType() else FSComp.SR.tcNewCannotBeUsedOnInterfaceType()), mWholeCall)) - + let rec getConstructorArgs expr = match expr with - | SynExpr.Paren(expr = SynExpr.App(funcExpr = expr)) -> - getConstructorArgs expr - | SynExpr.Paren(expr = SynExpr.Tuple(exprs = synExprs)) -> - synExprs |> List.collect getConstructorArgs - | SynExpr.App(funcExpr = expr1; argExpr = expr2) -> - getConstructorArgs expr1 @ getConstructorArgs expr2 + | SynExpr.Paren(expr = SynExpr.App(funcExpr = expr)) -> getConstructorArgs expr + | SynExpr.Paren(expr = SynExpr.Tuple(exprs = synExprs)) -> synExprs |> List.collect getConstructorArgs + | SynExpr.App(funcExpr = expr1; argExpr = expr2) -> [ expr1 ; expr2 ] |> List.collect getConstructorArgs | SynExpr.Ident(id) -> [ id ] | _ -> [] diff --git a/tests/FSharp.Compiler.ComponentTests/Language/ObsoleteAttributeCheckingTests.fs b/tests/FSharp.Compiler.ComponentTests/Language/ObsoleteAttributeCheckingTests.fs index 8ffa9618ab5..f69f168fe09 100644 --- a/tests/FSharp.Compiler.ComponentTests/Language/ObsoleteAttributeCheckingTests.fs +++ b/tests/FSharp.Compiler.ComponentTests/Language/ObsoleteAttributeCheckingTests.fs @@ -1351,8 +1351,7 @@ let options = JsonSerializerOptions(DefaultOptions = JsonSerializer1Options(Defa |> withDiagnostics [ (Error 101, Line 14, Col 77, Line 14, Col 91, "This construct is deprecated. This is bad") ] - - + [] let ``Obsolete attribute warning is taken into account in a constructor property assignment from a csharp class`` () = let CSLib = From 201470a33f119231ec8b20527d824ba7c89d8e57 Mon Sep 17 00:00:00 2001 From: Edgar Gonzalez Date: Tue, 26 Mar 2024 15:08:28 +0000 Subject: [PATCH 10/12] FIx PR comments --- src/Compiler/Checking/CheckExpressions.fs | 93 ++++++++++--------- .../ObsoleteAttributeCheckingTests.fs | 40 ++++++++ 2 files changed, 90 insertions(+), 43 deletions(-) diff --git a/src/Compiler/Checking/CheckExpressions.fs b/src/Compiler/Checking/CheckExpressions.fs index 5b50d34ccac..971ea34acde 100644 --- a/src/Compiler/Checking/CheckExpressions.fs +++ b/src/Compiler/Checking/CheckExpressions.fs @@ -1234,12 +1234,34 @@ let CheckForAbnormalOperatorNames (cenv: cenv) (idRange: range) coreDisplayName if isMember then warning(StandardOperatorRedefinitionWarning(FSComp.SR.tcInvalidMemberNameFixedTypes opName, idRange)) | Other -> () + +let GetConstructorArgsIdents synExprs = + let rec getConstructorArgs expr = + match expr with + | SynExpr.Paren(expr = SynExpr.App(funcExpr = expr)) -> getConstructorArgs expr + | SynExpr.Paren(expr = SynExpr.Tuple(exprs = synExprs)) -> synExprs |> List.collect getConstructorArgs + | SynExpr.App(funcExpr = expr1; argExpr = expr2) -> [ expr1 ; expr2 ] |> List.collect getConstructorArgs + | SynExpr.Ident(id) -> [ id ] + | _ -> [] + + synExprs |> List.collect getConstructorArgs + let CheckInitProperties (g: TcGlobals) (minfo: MethInfo) methodName mItem = if g.langVersion.SupportsFeature(LanguageFeature.InitPropertiesSupport) then // Check, wheter this method has external init, emit an error diagnostic in this case. if minfo.HasExternalInit then errorR (Error (FSComp.SR.tcSetterForInitOnlyPropertyCannotBeCalled1 methodName, mItem)) + +let CheckPropertyAttributes finalAssignedItemSetters (ctorArgs: Ident list) = + let propInfos = + finalAssignedItemSetters + |> List.choose (function | AssignedItemSetter(_, AssignedPropSetter (_, pinfo, _, _), _) -> Some pinfo | _ -> None) + + for propInfo in propInfos do + for arg in ctorArgs do + if arg.idText = propInfo.DisplayName then + CheckPropInfoAttributes propInfo arg.idRange |> CommitOperationResult let CheckRequiredProperties (g:TcGlobals) (env: TcEnv) (cenv: TcFileState) (minfo: MethInfo) finalAssignedItemSetters mMethExpr = // Make sure, if apparent type has any required properties, they all are in the `finalAssignedItemSetters`. @@ -6650,21 +6672,13 @@ and TcCtorCall isNaked cenv env tpenv (overallTy: OverallTy) objTy mObjTyOpt ite if isInterfaceTy g objTy then error(Error((if superInit then FSComp.SR.tcInheritCannotBeUsedOnInterfaceType() else FSComp.SR.tcNewCannotBeUsedOnInterfaceType()), mWholeCall)) - let rec getConstructorArgs expr = - match expr with - | SynExpr.Paren(expr = SynExpr.App(funcExpr = expr)) -> getConstructorArgs expr - | SynExpr.Paren(expr = SynExpr.Tuple(exprs = synExprs)) -> synExprs |> List.collect getConstructorArgs - | SynExpr.App(funcExpr = expr1; argExpr = expr2) -> [ expr1 ; expr2 ] |> List.collect getConstructorArgs - | SynExpr.Ident(id) -> [ id ] - | _ -> [] - match item, args with | Item.CtorGroup(methodName, minfos), argExprs -> let meths = List.map (fun minfo -> minfo, None) minfos if isNaked && TypeFeasiblySubsumesType 0 g cenv.amap mWholeCall g.system_IDisposable_ty NoCoerce objTy then warning(Error(FSComp.SR.tcIDisposableTypeShouldUseNew(), mWholeCall)) - let ctorArgs = argExprs |> List.collect getConstructorArgs + let ctorArgs = GetConstructorArgsIdents argExprs if not ctorArgs.IsEmpty then // Here we will have the ValRefs(Members, Properties) from F# types @@ -6672,22 +6686,11 @@ and TcCtorCall isNaked cenv env tpenv (overallTy: OverallTy) objTy mObjTyOpt ite minfos |> List.collect (fun minfo-> minfo.ApparentEnclosingTyconRef.MembersOfFSharpTyconSorted) |> List.filter (fun v -> CheckFSharpAttributesForObsolete g v.Attribs) - - if valRefs.IsEmpty then - // Here we will have the PropInfos from C# types - let propInfos = - minfos - |> List.collect (fun minfo -> GetImmediateIntrinsicPropInfosOfType (None, AccessibleFromSomeFSharpCode) g cenv.amap range0 minfo.ApparentEnclosingType) - - for propInfo in propInfos do - for arg in ctorArgs do - if arg.idText = propInfo.DisplayName then - CheckPropInfoAttributes propInfo arg.idRange |> CommitOperationResult - else - for vref in valRefs do - for arg in ctorArgs do - if arg.idText = vref.DisplayName then - CheckValAttributes g vref arg.idRange |> CommitOperationResult + + for vref in valRefs do + for arg in ctorArgs do + if arg.idText = vref.DisplayName then + CheckValAttributes g vref arg.idRange |> CommitOperationResult // Check the type is not abstract // skip this check if this ctor call is either 'inherit(...)' or call is located within constructor shape @@ -6700,7 +6703,7 @@ and TcCtorCall isNaked cenv env tpenv (overallTy: OverallTy) objTy mObjTyOpt ite | Some mObjTy, None -> ForNewConstructors cenv.tcSink env mObjTy methodName minfos | None, _ -> AfterResolution.DoNothing - TcMethodApplicationThen cenv env overallTy (Some objTy) tpenv None [] mWholeCall mItem methodName ad PossiblyMutates false meths afterResolution isSuperInit args ExprAtomicFlag.NonAtomic None delayed + TcMethodApplicationThen cenv env overallTy (Some objTy) tpenv None [] mWholeCall mItem methodName ad PossiblyMutates false meths afterResolution isSuperInit args ExprAtomicFlag.NonAtomic None delayed ctorArgs | Item.DelegateCtor ty, [arg] -> // Re-record the name resolution since we now know it's a constructor call @@ -7115,7 +7118,7 @@ and TcObjectExpr (cenv: cenv) env tpenv (objTy, realObjTy, argopt, binds, extraI let afterResolution = ForNewConstructors cenv.tcSink env mObjTy methodName minfos let ad = env.AccessRights - let expr, tpenv = TcMethodApplicationThen cenv env (MustEqual objTy) None tpenv None [] mWholeExpr mObjTy methodName ad PossiblyMutates false meths afterResolution CtorValUsedAsSuperInit [arg] ExprAtomicFlag.Atomic None [] + let expr, tpenv = TcMethodApplicationThen cenv env (MustEqual objTy) None tpenv None [] mWholeExpr mObjTy methodName ad PossiblyMutates false meths afterResolution CtorValUsedAsSuperInit [arg] ExprAtomicFlag.Atomic None [] [] // The 'base' value is always bound let baseIdOpt = (match baseIdOpt with None -> Some(ident("base", mObjTy)) | Some id -> Some id) expr, baseIdOpt, tpenv @@ -8756,7 +8759,7 @@ and TcMethodItemThen (cenv: cenv) overallTy env item methodName minfos tpenv mIt let meths = List.map (fun minfo -> minfo, None) minfos match delayed with | DelayedApp (atomicFlag, _, _, arg, mExprAndArg) :: otherDelayed -> - TcMethodApplicationThen cenv env overallTy None tpenv None [] mExprAndArg mItem methodName ad NeverMutates false meths afterResolution NormalValUse [arg] atomicFlag staticTyOpt otherDelayed + TcMethodApplicationThen cenv env overallTy None tpenv None [] mExprAndArg mItem methodName ad NeverMutates false meths afterResolution NormalValUse [arg] atomicFlag staticTyOpt otherDelayed [] | DelayedTypeApp(tys, mTypeArgs, mExprAndTypeArgs) :: otherDelayed -> @@ -8770,9 +8773,9 @@ and TcMethodItemThen (cenv: cenv) overallTy env item methodName minfos tpenv mIt match otherDelayed with | DelayedApp(atomicFlag, _, _, arg, mExprAndArg) :: otherDelayed -> - TcMethodApplicationThen cenv env overallTy None tpenv None [] mExprAndArg mItem methodName ad NeverMutates false [(minfoAfterStaticArguments, None)] afterResolution NormalValUse [arg] atomicFlag staticTyOpt otherDelayed + TcMethodApplicationThen cenv env overallTy None tpenv None [] mExprAndArg mItem methodName ad NeverMutates false [(minfoAfterStaticArguments, None)] afterResolution NormalValUse [arg] atomicFlag staticTyOpt otherDelayed [] | _ -> - TcMethodApplicationThen cenv env overallTy None tpenv None [] mExprAndTypeArgs mItem methodName ad NeverMutates false [(minfoAfterStaticArguments, None)] afterResolution NormalValUse [] ExprAtomicFlag.Atomic staticTyOpt otherDelayed + TcMethodApplicationThen cenv env overallTy None tpenv None [] mExprAndTypeArgs mItem methodName ad NeverMutates false [(minfoAfterStaticArguments, None)] afterResolution NormalValUse [] ExprAtomicFlag.Atomic staticTyOpt otherDelayed [] | None -> #endif @@ -8786,16 +8789,16 @@ and TcMethodItemThen (cenv: cenv) overallTy env item methodName minfos tpenv mIt match otherDelayed with | DelayedApp(atomicFlag, _, _, arg, mExprAndArg) :: otherDelayed -> - TcMethodApplicationThen cenv env overallTy None tpenv (Some tyargs) [] mExprAndArg mItem methodName ad NeverMutates false meths afterResolution NormalValUse [arg] atomicFlag staticTyOpt otherDelayed + TcMethodApplicationThen cenv env overallTy None tpenv (Some tyargs) [] mExprAndArg mItem methodName ad NeverMutates false meths afterResolution NormalValUse [arg] atomicFlag staticTyOpt otherDelayed [] | _ -> - TcMethodApplicationThen cenv env overallTy None tpenv (Some tyargs) [] mExprAndTypeArgs mItem methodName ad NeverMutates false meths afterResolution NormalValUse [] ExprAtomicFlag.Atomic staticTyOpt otherDelayed + TcMethodApplicationThen cenv env overallTy None tpenv (Some tyargs) [] mExprAndTypeArgs mItem methodName ad NeverMutates false meths afterResolution NormalValUse [] ExprAtomicFlag.Atomic staticTyOpt otherDelayed [] | _ -> #if !NO_TYPEPROVIDERS if not minfos.IsEmpty && minfos[0].ProvidedStaticParameterInfo.IsSome then error(Error(FSComp.SR.etMissingStaticArgumentsToMethod(), mItem)) #endif - TcMethodApplicationThen cenv env overallTy None tpenv None [] mItem mItem methodName ad NeverMutates false meths afterResolution NormalValUse [] ExprAtomicFlag.Atomic staticTyOpt delayed + TcMethodApplicationThen cenv env overallTy None tpenv None [] mItem mItem methodName ad NeverMutates false meths afterResolution NormalValUse [] ExprAtomicFlag.Atomic staticTyOpt delayed [] and TcCtorItemThen (cenv: cenv) overallTy env item nm minfos tinstEnclosing tpenv mItem afterResolution delayed = #if !NO_TYPEPROVIDERS @@ -9163,19 +9166,19 @@ and TcPropertyItemThen cenv overallTy env nm pinfos tpenv mItem afterResolution // x.P <- ... byref setter if isNil meths then error (Error (FSComp.SR.tcPropertyIsNotReadable nm, mItem)) - TcMethodApplicationThen cenv env overallTy None tpenv tyArgsOpt [] mItem mItem nm ad NeverMutates true meths afterResolution NormalValUse args ExprAtomicFlag.Atomic staticTyOpt delayed + TcMethodApplicationThen cenv env overallTy None tpenv tyArgsOpt [] mItem mItem nm ad NeverMutates true meths afterResolution NormalValUse args ExprAtomicFlag.Atomic staticTyOpt delayed [] else let args = if pinfo.IsIndexer then args else [] if isNil meths then errorR (Error (FSComp.SR.tcPropertyCannotBeSet1 nm, mItem)) // Note: static calls never mutate a struct object argument - TcMethodApplicationThen cenv env overallTy None tpenv tyArgsOpt [] mStmt mItem nm ad NeverMutates true meths afterResolution NormalValUse (args@[expr2]) ExprAtomicFlag.NonAtomic staticTyOpt otherDelayed + TcMethodApplicationThen cenv env overallTy None tpenv tyArgsOpt [] mStmt mItem nm ad NeverMutates true meths afterResolution NormalValUse (args@[expr2]) ExprAtomicFlag.NonAtomic staticTyOpt otherDelayed [] | _ -> // Static Property Get (possibly indexer) let meths = pinfos |> GettersOfPropInfos if isNil meths then error (Error (FSComp.SR.tcPropertyIsNotReadable nm, mItem)) // Note: static calls never mutate a struct object argument - TcMethodApplicationThen cenv env overallTy None tpenv tyArgsOpt [] mItem mItem nm ad NeverMutates true meths afterResolution NormalValUse args ExprAtomicFlag.Atomic staticTyOpt delayed + TcMethodApplicationThen cenv env overallTy None tpenv tyArgsOpt [] mItem mItem nm ad NeverMutates true meths afterResolution NormalValUse args ExprAtomicFlag.Atomic staticTyOpt delayed [] and TcILFieldItemThen cenv overallTy env finfo tpenv mItem delayed = let g = cenv.g @@ -9327,7 +9330,7 @@ and TcLookupItemThen cenv overallTy env tpenv mObjExpr objExpr objExprTy delayed let item = Item.MethodGroup(methodName, [minfoAfterStaticArguments], Some minfos[0]) CallNameResolutionSinkReplacing cenv.tcSink (mExprAndItem, env.NameEnv, item, [], ItemOccurence.Use, env.eAccessRights) - TcMethodApplicationThen cenv env overallTy None tpenv None objArgs mExprAndItem mItem methodName ad mutates false [(minfoAfterStaticArguments, None)] afterResolution NormalValUse args atomicFlag None delayed + TcMethodApplicationThen cenv env overallTy None tpenv None objArgs mExprAndItem mItem methodName ad mutates false [(minfoAfterStaticArguments, None)] afterResolution NormalValUse args atomicFlag None delayed [] | None -> if not minfos.IsEmpty && minfos[0].ProvidedStaticParameterInfo.IsSome then error(Error(FSComp.SR.etMissingStaticArgumentsToMethod(), mItem)) @@ -9336,7 +9339,7 @@ and TcLookupItemThen cenv overallTy env tpenv mObjExpr objExpr objExprTy delayed let tyArgsOpt, tpenv = TcMemberTyArgsOpt cenv env tpenv tyArgsOpt let meths = minfos |> List.map (fun minfo -> minfo, None) - TcMethodApplicationThen cenv env overallTy None tpenv tyArgsOpt objArgs mExprAndItem mItem methodName ad mutates false meths afterResolution NormalValUse args atomicFlag None delayed + TcMethodApplicationThen cenv env overallTy None tpenv tyArgsOpt objArgs mExprAndItem mItem methodName ad mutates false meths afterResolution NormalValUse args atomicFlag None delayed [] | Item.Property (nm, pinfos, _) -> // Instance property @@ -9364,7 +9367,7 @@ and TcLookupItemThen cenv overallTy env tpenv mObjExpr objExpr objExprTy delayed errorR (Error (FSComp.SR.tcPropertyCannotBeSet1 nm, mItem)) // x.P <- ... byref setter if isNil meths then error (Error (FSComp.SR.tcPropertyIsNotReadable nm, mItem)) - TcMethodApplicationThen cenv env overallTy None tpenv tyArgsOpt objArgs mExprAndItem mItem nm ad PossiblyMutates true meths afterResolution NormalValUse args atomicFlag None delayed + TcMethodApplicationThen cenv env overallTy None tpenv tyArgsOpt objArgs mExprAndItem mItem nm ad PossiblyMutates true meths afterResolution NormalValUse args atomicFlag None delayed [] else if g.langVersion.SupportsFeature(LanguageFeature.RequiredPropertiesSupport) && pinfo.IsSetterInitOnly then @@ -9372,12 +9375,12 @@ and TcLookupItemThen cenv overallTy env tpenv mObjExpr objExpr objExprTy delayed let args = if pinfo.IsIndexer then args else [] let mut = (if isStructTy g (tyOfExpr g objExpr) then DefinitelyMutates else PossiblyMutates) - TcMethodApplicationThen cenv env overallTy None tpenv tyArgsOpt objArgs mStmt mItem nm ad mut true meths afterResolution NormalValUse (args @ [expr2]) atomicFlag None [] + TcMethodApplicationThen cenv env overallTy None tpenv tyArgsOpt objArgs mStmt mItem nm ad mut true meths afterResolution NormalValUse (args @ [expr2]) atomicFlag None [] [] | _ -> // Instance property getter let meths = GettersOfPropInfos pinfos if isNil meths then error (Error (FSComp.SR.tcPropertyIsNotReadable nm, mItem)) - TcMethodApplicationThen cenv env overallTy None tpenv tyArgsOpt objArgs mExprAndItem mItem nm ad PossiblyMutates true meths afterResolution NormalValUse args atomicFlag None delayed + TcMethodApplicationThen cenv env overallTy None tpenv tyArgsOpt objArgs mExprAndItem mItem nm ad PossiblyMutates true meths afterResolution NormalValUse args atomicFlag None delayed [] | Item.RecdField rfinfo -> // Get or set instance F# field or literal @@ -9540,6 +9543,7 @@ and TcMethodApplicationThen atomicFlag // is the expression atomic or not? staticTyOpt // is there a static type that governs the call, different to the nominal type containing the member, e.g. 'T.CallSomeMethod() delayed // further lookups and applications that follow this + ctorArgs // arguments to the constructor, if this is a constructor call = let g = cenv.g @@ -9556,7 +9560,7 @@ and TcMethodApplicationThen // Call the helper below to do the real checking let (expr, attributeAssignedNamedItems, delayed), tpenv = - TcMethodApplication false cenv env tpenv callerTyArgs objArgs mWholeExpr mItem methodName objTyOpt ad mut isProp meths afterResolution isSuperInit args exprTy staticTyOpt delayed + TcMethodApplication false cenv env tpenv callerTyArgs objArgs mWholeExpr mItem methodName objTyOpt ad mut isProp meths afterResolution isSuperInit args exprTy staticTyOpt delayed ctorArgs // Give errors if some things couldn't be assigned if not (isNil attributeAssignedNamedItems) then @@ -9927,6 +9931,7 @@ and TcMethodApplication (exprTy: OverallTy) staticTyOpt // is there a static type that governs the call, different to the nominal type containing the member, e.g. 'T.CallSomeMethod() delayed + ctorArgs = let g = cenv.g @@ -10119,6 +10124,8 @@ and TcMethodApplication // Handle post-hoc property assignments let setterExprPrebinders, callExpr2b = let expr = callExpr2 + + CheckPropertyAttributes finalAssignedItemSetters ctorArgs CheckRequiredProperties g env cenv finalCalledMethInfo finalAssignedItemSetters mMethExpr @@ -11105,7 +11112,7 @@ and TcAttributeEx canFail (cenv: cenv) (env: TcEnv) attrTgt attrEx (synAttr: Syn let meths = minfos |> List.map (fun minfo -> minfo, None) 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 [] + TcMethodApplication true cenv env tpenv None [] mAttr mAttr methodName None ad PossiblyMutates false meths afterResolution NormalValUse [arg] (MustEqual ty) None [] [] UnifyTypes cenv env mAttr ty (tyOfExpr g expr) diff --git a/tests/FSharp.Compiler.ComponentTests/Language/ObsoleteAttributeCheckingTests.fs b/tests/FSharp.Compiler.ComponentTests/Language/ObsoleteAttributeCheckingTests.fs index f69f168fe09..164b7415b4e 100644 --- a/tests/FSharp.Compiler.ComponentTests/Language/ObsoleteAttributeCheckingTests.fs +++ b/tests/FSharp.Compiler.ComponentTests/Language/ObsoleteAttributeCheckingTests.fs @@ -1285,7 +1285,47 @@ let options2 = JsonSerializerOptions(DefaultOptions = true, DefaultOptions = fal (Warning 44, Line 10, Col 61, Line 10, Col 75, "This construct is deprecated. This is bad") (Error 364, Line 10, Col 16, Line 10, Col 84, "The named argument 'DefaultOptions' has been assigned more than one value") ] + + [] // This should fail, Needs more investigation + let ``Obsolete attribute warning is not taken into account in prop setters that can be included in methods which are not constructors`` () = + Fsx """ +open System + +type JsonSerializerOptions() = + [] + member val DefaultOptions = false with get, set + member val UseCustomOptions = false with get, set + member this.With() = this + +let options = JsonSerializerOptions() +let options2 = + options + .With(DefaultOptions = true) + .With(UseCustomOptions = false) + """ + |> typecheck + |> shouldSucceed + [] // This should fail, Needs more investigation + let ``Obsolete attribute error is not taken into account in prop setters that can be included in methods which are not constructors`` () = + Fsx """ +open System + +type JsonSerializerOptions() = + [] + member val DefaultOptions = false with get, set + member val UseCustomOptions = false with get, set + member this.With() = this + +let options = JsonSerializerOptions() +let options2 = + options + .With(DefaultOptions = true) + .With(UseCustomOptions = false) + """ + |> typecheck + |> shouldSucceed + [] let ``Obsolete attribute error is taken into account in a constructor property assignment`` () = Fsx """ From af745e0138e966aabb544a020bddbda4d597a8ba Mon Sep 17 00:00:00 2001 From: Edgar Gonzalez Date: Thu, 28 Mar 2024 10:56:41 +0000 Subject: [PATCH 11/12] Simplify check --- src/Compiler/Checking/CheckExpressions.fs | 83 ++++++------------- .../ObsoleteAttributeCheckingTests.fs | 20 +++-- 2 files changed, 39 insertions(+), 64 deletions(-) diff --git a/src/Compiler/Checking/CheckExpressions.fs b/src/Compiler/Checking/CheckExpressions.fs index 971ea34acde..63b559fc6f6 100644 --- a/src/Compiler/Checking/CheckExpressions.fs +++ b/src/Compiler/Checking/CheckExpressions.fs @@ -1234,18 +1234,6 @@ let CheckForAbnormalOperatorNames (cenv: cenv) (idRange: range) coreDisplayName if isMember then warning(StandardOperatorRedefinitionWarning(FSComp.SR.tcInvalidMemberNameFixedTypes opName, idRange)) | Other -> () - -let GetConstructorArgsIdents synExprs = - let rec getConstructorArgs expr = - match expr with - | SynExpr.Paren(expr = SynExpr.App(funcExpr = expr)) -> getConstructorArgs expr - | SynExpr.Paren(expr = SynExpr.Tuple(exprs = synExprs)) -> synExprs |> List.collect getConstructorArgs - | SynExpr.App(funcExpr = expr1; argExpr = expr2) -> [ expr1 ; expr2 ] |> List.collect getConstructorArgs - | SynExpr.Ident(id) -> [ id ] - | _ -> [] - - synExprs |> List.collect getConstructorArgs - let CheckInitProperties (g: TcGlobals) (minfo: MethInfo) methodName mItem = if g.langVersion.SupportsFeature(LanguageFeature.InitPropertiesSupport) then @@ -1253,15 +1241,12 @@ let CheckInitProperties (g: TcGlobals) (minfo: MethInfo) methodName mItem = if minfo.HasExternalInit then errorR (Error (FSComp.SR.tcSetterForInitOnlyPropertyCannotBeCalled1 methodName, mItem)) -let CheckPropertyAttributes finalAssignedItemSetters (ctorArgs: Ident list) = - let propInfos = - finalAssignedItemSetters - |> List.choose (function | AssignedItemSetter(_, AssignedPropSetter (_, pinfo, _, _), _) -> Some pinfo | _ -> None) - - for propInfo in propInfos do - for arg in ctorArgs do - if arg.idText = propInfo.DisplayName then - CheckPropInfoAttributes propInfo arg.idRange |> CommitOperationResult +let CheckPropertyAttributes finalAssignedItemSetters = + for propInfo in finalAssignedItemSetters do + match propInfo with + | AssignedItemSetter(ident, AssignedPropSetter (_, pinfo, _, _), _) -> + CheckPropInfoAttributes pinfo ident.idRange |> CommitOperationResult + | _ -> () let CheckRequiredProperties (g:TcGlobals) (env: TcEnv) (cenv: TcFileState) (minfo: MethInfo) finalAssignedItemSetters mMethExpr = // Make sure, if apparent type has any required properties, they all are in the `finalAssignedItemSetters`. @@ -6673,25 +6658,11 @@ and TcCtorCall isNaked cenv env tpenv (overallTy: OverallTy) objTy mObjTyOpt ite error(Error((if superInit then FSComp.SR.tcInheritCannotBeUsedOnInterfaceType() else FSComp.SR.tcNewCannotBeUsedOnInterfaceType()), mWholeCall)) match item, args with - | Item.CtorGroup(methodName, minfos), argExprs -> + | Item.CtorGroup(methodName, minfos), _ -> let meths = List.map (fun minfo -> minfo, None) minfos if isNaked && TypeFeasiblySubsumesType 0 g cenv.amap mWholeCall g.system_IDisposable_ty NoCoerce objTy then warning(Error(FSComp.SR.tcIDisposableTypeShouldUseNew(), mWholeCall)) - let ctorArgs = GetConstructorArgsIdents argExprs - - if not ctorArgs.IsEmpty then - // Here we will have the ValRefs(Members, Properties) from F# types - let valRefs = - minfos - |> List.collect (fun minfo-> minfo.ApparentEnclosingTyconRef.MembersOfFSharpTyconSorted) - |> List.filter (fun v -> CheckFSharpAttributesForObsolete g v.Attribs) - - for vref in valRefs do - for arg in ctorArgs do - if arg.idText = vref.DisplayName then - CheckValAttributes g vref arg.idRange |> CommitOperationResult - // Check the type is not abstract // skip this check if this ctor call is either 'inherit(...)' or call is located within constructor shape if not (superInit || AreWithinCtorShape env) @@ -6703,7 +6674,7 @@ and TcCtorCall isNaked cenv env tpenv (overallTy: OverallTy) objTy mObjTyOpt ite | Some mObjTy, None -> ForNewConstructors cenv.tcSink env mObjTy methodName minfos | None, _ -> AfterResolution.DoNothing - TcMethodApplicationThen cenv env overallTy (Some objTy) tpenv None [] mWholeCall mItem methodName ad PossiblyMutates false meths afterResolution isSuperInit args ExprAtomicFlag.NonAtomic None delayed ctorArgs + TcMethodApplicationThen cenv env overallTy (Some objTy) tpenv None [] mWholeCall mItem methodName ad PossiblyMutates false meths afterResolution isSuperInit args ExprAtomicFlag.NonAtomic None delayed | Item.DelegateCtor ty, [arg] -> // Re-record the name resolution since we now know it's a constructor call @@ -7118,7 +7089,7 @@ and TcObjectExpr (cenv: cenv) env tpenv (objTy, realObjTy, argopt, binds, extraI let afterResolution = ForNewConstructors cenv.tcSink env mObjTy methodName minfos let ad = env.AccessRights - let expr, tpenv = TcMethodApplicationThen cenv env (MustEqual objTy) None tpenv None [] mWholeExpr mObjTy methodName ad PossiblyMutates false meths afterResolution CtorValUsedAsSuperInit [arg] ExprAtomicFlag.Atomic None [] [] + let expr, tpenv = TcMethodApplicationThen cenv env (MustEqual objTy) None tpenv None [] mWholeExpr mObjTy methodName ad PossiblyMutates false meths afterResolution CtorValUsedAsSuperInit [arg] ExprAtomicFlag.Atomic None [] // The 'base' value is always bound let baseIdOpt = (match baseIdOpt with None -> Some(ident("base", mObjTy)) | Some id -> Some id) expr, baseIdOpt, tpenv @@ -8759,7 +8730,7 @@ and TcMethodItemThen (cenv: cenv) overallTy env item methodName minfos tpenv mIt let meths = List.map (fun minfo -> minfo, None) minfos match delayed with | DelayedApp (atomicFlag, _, _, arg, mExprAndArg) :: otherDelayed -> - TcMethodApplicationThen cenv env overallTy None tpenv None [] mExprAndArg mItem methodName ad NeverMutates false meths afterResolution NormalValUse [arg] atomicFlag staticTyOpt otherDelayed [] + TcMethodApplicationThen cenv env overallTy None tpenv None [] mExprAndArg mItem methodName ad NeverMutates false meths afterResolution NormalValUse [arg] atomicFlag staticTyOpt otherDelayed | DelayedTypeApp(tys, mTypeArgs, mExprAndTypeArgs) :: otherDelayed -> @@ -8773,9 +8744,9 @@ and TcMethodItemThen (cenv: cenv) overallTy env item methodName minfos tpenv mIt match otherDelayed with | DelayedApp(atomicFlag, _, _, arg, mExprAndArg) :: otherDelayed -> - TcMethodApplicationThen cenv env overallTy None tpenv None [] mExprAndArg mItem methodName ad NeverMutates false [(minfoAfterStaticArguments, None)] afterResolution NormalValUse [arg] atomicFlag staticTyOpt otherDelayed [] + TcMethodApplicationThen cenv env overallTy None tpenv None [] mExprAndArg mItem methodName ad NeverMutates false [(minfoAfterStaticArguments, None)] afterResolution NormalValUse [arg] atomicFlag staticTyOpt otherDelayed | _ -> - TcMethodApplicationThen cenv env overallTy None tpenv None [] mExprAndTypeArgs mItem methodName ad NeverMutates false [(minfoAfterStaticArguments, None)] afterResolution NormalValUse [] ExprAtomicFlag.Atomic staticTyOpt otherDelayed [] + TcMethodApplicationThen cenv env overallTy None tpenv None [] mExprAndTypeArgs mItem methodName ad NeverMutates false [(minfoAfterStaticArguments, None)] afterResolution NormalValUse [] ExprAtomicFlag.Atomic staticTyOpt otherDelayed | None -> #endif @@ -8789,16 +8760,16 @@ and TcMethodItemThen (cenv: cenv) overallTy env item methodName minfos tpenv mIt match otherDelayed with | DelayedApp(atomicFlag, _, _, arg, mExprAndArg) :: otherDelayed -> - TcMethodApplicationThen cenv env overallTy None tpenv (Some tyargs) [] mExprAndArg mItem methodName ad NeverMutates false meths afterResolution NormalValUse [arg] atomicFlag staticTyOpt otherDelayed [] + TcMethodApplicationThen cenv env overallTy None tpenv (Some tyargs) [] mExprAndArg mItem methodName ad NeverMutates false meths afterResolution NormalValUse [arg] atomicFlag staticTyOpt otherDelayed | _ -> - TcMethodApplicationThen cenv env overallTy None tpenv (Some tyargs) [] mExprAndTypeArgs mItem methodName ad NeverMutates false meths afterResolution NormalValUse [] ExprAtomicFlag.Atomic staticTyOpt otherDelayed [] + TcMethodApplicationThen cenv env overallTy None tpenv (Some tyargs) [] mExprAndTypeArgs mItem methodName ad NeverMutates false meths afterResolution NormalValUse [] ExprAtomicFlag.Atomic staticTyOpt otherDelayed | _ -> #if !NO_TYPEPROVIDERS if not minfos.IsEmpty && minfos[0].ProvidedStaticParameterInfo.IsSome then error(Error(FSComp.SR.etMissingStaticArgumentsToMethod(), mItem)) #endif - TcMethodApplicationThen cenv env overallTy None tpenv None [] mItem mItem methodName ad NeverMutates false meths afterResolution NormalValUse [] ExprAtomicFlag.Atomic staticTyOpt delayed [] + TcMethodApplicationThen cenv env overallTy None tpenv None [] mItem mItem methodName ad NeverMutates false meths afterResolution NormalValUse [] ExprAtomicFlag.Atomic staticTyOpt delayed and TcCtorItemThen (cenv: cenv) overallTy env item nm minfos tinstEnclosing tpenv mItem afterResolution delayed = #if !NO_TYPEPROVIDERS @@ -9166,19 +9137,19 @@ and TcPropertyItemThen cenv overallTy env nm pinfos tpenv mItem afterResolution // x.P <- ... byref setter if isNil meths then error (Error (FSComp.SR.tcPropertyIsNotReadable nm, mItem)) - TcMethodApplicationThen cenv env overallTy None tpenv tyArgsOpt [] mItem mItem nm ad NeverMutates true meths afterResolution NormalValUse args ExprAtomicFlag.Atomic staticTyOpt delayed [] + TcMethodApplicationThen cenv env overallTy None tpenv tyArgsOpt [] mItem mItem nm ad NeverMutates true meths afterResolution NormalValUse args ExprAtomicFlag.Atomic staticTyOpt delayed else let args = if pinfo.IsIndexer then args else [] if isNil meths then errorR (Error (FSComp.SR.tcPropertyCannotBeSet1 nm, mItem)) // Note: static calls never mutate a struct object argument - TcMethodApplicationThen cenv env overallTy None tpenv tyArgsOpt [] mStmt mItem nm ad NeverMutates true meths afterResolution NormalValUse (args@[expr2]) ExprAtomicFlag.NonAtomic staticTyOpt otherDelayed [] + TcMethodApplicationThen cenv env overallTy None tpenv tyArgsOpt [] mStmt mItem nm ad NeverMutates true meths afterResolution NormalValUse (args@[expr2]) ExprAtomicFlag.NonAtomic staticTyOpt otherDelayed | _ -> // Static Property Get (possibly indexer) let meths = pinfos |> GettersOfPropInfos if isNil meths then error (Error (FSComp.SR.tcPropertyIsNotReadable nm, mItem)) // Note: static calls never mutate a struct object argument - TcMethodApplicationThen cenv env overallTy None tpenv tyArgsOpt [] mItem mItem nm ad NeverMutates true meths afterResolution NormalValUse args ExprAtomicFlag.Atomic staticTyOpt delayed [] + TcMethodApplicationThen cenv env overallTy None tpenv tyArgsOpt [] mItem mItem nm ad NeverMutates true meths afterResolution NormalValUse args ExprAtomicFlag.Atomic staticTyOpt delayed and TcILFieldItemThen cenv overallTy env finfo tpenv mItem delayed = let g = cenv.g @@ -9330,7 +9301,7 @@ and TcLookupItemThen cenv overallTy env tpenv mObjExpr objExpr objExprTy delayed let item = Item.MethodGroup(methodName, [minfoAfterStaticArguments], Some minfos[0]) CallNameResolutionSinkReplacing cenv.tcSink (mExprAndItem, env.NameEnv, item, [], ItemOccurence.Use, env.eAccessRights) - TcMethodApplicationThen cenv env overallTy None tpenv None objArgs mExprAndItem mItem methodName ad mutates false [(minfoAfterStaticArguments, None)] afterResolution NormalValUse args atomicFlag None delayed [] + TcMethodApplicationThen cenv env overallTy None tpenv None objArgs mExprAndItem mItem methodName ad mutates false [(minfoAfterStaticArguments, None)] afterResolution NormalValUse args atomicFlag None delayed | None -> if not minfos.IsEmpty && minfos[0].ProvidedStaticParameterInfo.IsSome then error(Error(FSComp.SR.etMissingStaticArgumentsToMethod(), mItem)) @@ -9339,7 +9310,7 @@ and TcLookupItemThen cenv overallTy env tpenv mObjExpr objExpr objExprTy delayed let tyArgsOpt, tpenv = TcMemberTyArgsOpt cenv env tpenv tyArgsOpt let meths = minfos |> List.map (fun minfo -> minfo, None) - TcMethodApplicationThen cenv env overallTy None tpenv tyArgsOpt objArgs mExprAndItem mItem methodName ad mutates false meths afterResolution NormalValUse args atomicFlag None delayed [] + TcMethodApplicationThen cenv env overallTy None tpenv tyArgsOpt objArgs mExprAndItem mItem methodName ad mutates false meths afterResolution NormalValUse args atomicFlag None delayed | Item.Property (nm, pinfos, _) -> // Instance property @@ -9367,7 +9338,7 @@ and TcLookupItemThen cenv overallTy env tpenv mObjExpr objExpr objExprTy delayed errorR (Error (FSComp.SR.tcPropertyCannotBeSet1 nm, mItem)) // x.P <- ... byref setter if isNil meths then error (Error (FSComp.SR.tcPropertyIsNotReadable nm, mItem)) - TcMethodApplicationThen cenv env overallTy None tpenv tyArgsOpt objArgs mExprAndItem mItem nm ad PossiblyMutates true meths afterResolution NormalValUse args atomicFlag None delayed [] + TcMethodApplicationThen cenv env overallTy None tpenv tyArgsOpt objArgs mExprAndItem mItem nm ad PossiblyMutates true meths afterResolution NormalValUse args atomicFlag None delayed else if g.langVersion.SupportsFeature(LanguageFeature.RequiredPropertiesSupport) && pinfo.IsSetterInitOnly then @@ -9375,12 +9346,12 @@ and TcLookupItemThen cenv overallTy env tpenv mObjExpr objExpr objExprTy delayed let args = if pinfo.IsIndexer then args else [] let mut = (if isStructTy g (tyOfExpr g objExpr) then DefinitelyMutates else PossiblyMutates) - TcMethodApplicationThen cenv env overallTy None tpenv tyArgsOpt objArgs mStmt mItem nm ad mut true meths afterResolution NormalValUse (args @ [expr2]) atomicFlag None [] [] + TcMethodApplicationThen cenv env overallTy None tpenv tyArgsOpt objArgs mStmt mItem nm ad mut true meths afterResolution NormalValUse (args @ [expr2]) atomicFlag None [] | _ -> // Instance property getter let meths = GettersOfPropInfos pinfos if isNil meths then error (Error (FSComp.SR.tcPropertyIsNotReadable nm, mItem)) - TcMethodApplicationThen cenv env overallTy None tpenv tyArgsOpt objArgs mExprAndItem mItem nm ad PossiblyMutates true meths afterResolution NormalValUse args atomicFlag None delayed [] + TcMethodApplicationThen cenv env overallTy None tpenv tyArgsOpt objArgs mExprAndItem mItem nm ad PossiblyMutates true meths afterResolution NormalValUse args atomicFlag None delayed | Item.RecdField rfinfo -> // Get or set instance F# field or literal @@ -9543,7 +9514,6 @@ and TcMethodApplicationThen atomicFlag // is the expression atomic or not? staticTyOpt // is there a static type that governs the call, different to the nominal type containing the member, e.g. 'T.CallSomeMethod() delayed // further lookups and applications that follow this - ctorArgs // arguments to the constructor, if this is a constructor call = let g = cenv.g @@ -9560,7 +9530,7 @@ and TcMethodApplicationThen // Call the helper below to do the real checking let (expr, attributeAssignedNamedItems, delayed), tpenv = - TcMethodApplication false cenv env tpenv callerTyArgs objArgs mWholeExpr mItem methodName objTyOpt ad mut isProp meths afterResolution isSuperInit args exprTy staticTyOpt delayed ctorArgs + TcMethodApplication false cenv env tpenv callerTyArgs objArgs mWholeExpr mItem methodName objTyOpt ad mut isProp meths afterResolution isSuperInit args exprTy staticTyOpt delayed // Give errors if some things couldn't be assigned if not (isNil attributeAssignedNamedItems) then @@ -9931,7 +9901,6 @@ and TcMethodApplication (exprTy: OverallTy) staticTyOpt // is there a static type that governs the call, different to the nominal type containing the member, e.g. 'T.CallSomeMethod() delayed - ctorArgs = let g = cenv.g @@ -10125,7 +10094,7 @@ and TcMethodApplication let setterExprPrebinders, callExpr2b = let expr = callExpr2 - CheckPropertyAttributes finalAssignedItemSetters ctorArgs + CheckPropertyAttributes finalAssignedItemSetters CheckRequiredProperties g env cenv finalCalledMethInfo finalAssignedItemSetters mMethExpr @@ -11112,7 +11081,7 @@ and TcAttributeEx canFail (cenv: cenv) (env: TcEnv) attrTgt attrEx (synAttr: Syn let meths = minfos |> List.map (fun minfo -> minfo, None) 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 [] [] + TcMethodApplication true cenv env tpenv None [] mAttr mAttr methodName None ad PossiblyMutates false meths afterResolution NormalValUse [arg] (MustEqual ty) None [] UnifyTypes cenv env mAttr ty (tyOfExpr g expr) diff --git a/tests/FSharp.Compiler.ComponentTests/Language/ObsoleteAttributeCheckingTests.fs b/tests/FSharp.Compiler.ComponentTests/Language/ObsoleteAttributeCheckingTests.fs index 164b7415b4e..f31371a9653 100644 --- a/tests/FSharp.Compiler.ComponentTests/Language/ObsoleteAttributeCheckingTests.fs +++ b/tests/FSharp.Compiler.ComponentTests/Language/ObsoleteAttributeCheckingTests.fs @@ -1281,18 +1281,18 @@ let options2 = JsonSerializerOptions(DefaultOptions = true, DefaultOptions = fal |> shouldFail |> withDiagnostics [ (Warning 44, Line 9, Col 37, Line 9, Col 51, "This construct is deprecated. This is bad") + (Error 364, Line 10, Col 16, Line 10, Col 84, "The named argument 'DefaultOptions' has been assigned more than one value") (Warning 44, Line 10, Col 38, Line 10, Col 52, "This construct is deprecated. This is bad") (Warning 44, Line 10, Col 61, Line 10, Col 75, "This construct is deprecated. This is bad") - (Error 364, Line 10, Col 16, Line 10, Col 84, "The named argument 'DefaultOptions' has been assigned more than one value") ] - [] // This should fail, Needs more investigation + [] let ``Obsolete attribute warning is not taken into account in prop setters that can be included in methods which are not constructors`` () = Fsx """ open System type JsonSerializerOptions() = - [] + [] member val DefaultOptions = false with get, set member val UseCustomOptions = false with get, set member this.With() = this @@ -1304,9 +1304,11 @@ let options2 = .With(UseCustomOptions = false) """ |> typecheck - |> shouldSucceed + |> withDiagnostics [ + (Warning 44, Line 13, Col 15, Line 13, Col 29, "This construct is deprecated. This is bad") + ] - [] // This should fail, Needs more investigation + [] let ``Obsolete attribute error is not taken into account in prop setters that can be included in methods which are not constructors`` () = Fsx """ open System @@ -1324,7 +1326,10 @@ let options2 = .With(UseCustomOptions = false) """ |> typecheck - |> shouldSucceed + |> shouldFail + |> withDiagnostics [ + (Error 101, Line 13, Col 15, Line 13, Col 29, "This construct is deprecated. This is bad") + ] [] let ``Obsolete attribute error is taken into account in a constructor property assignment`` () = @@ -1342,7 +1347,8 @@ let options2 = JsonSerializerOptions(DefaultOptions = true, DefaultOptions = fal |> typecheck |> shouldFail |> withDiagnostics [ - (Error 101, Line 9, Col 37, Line 9, Col 51, "This construct is deprecated. This is bad") + (Error 101, Line 9, Col 37, Line 9, Col 51, "This construct is deprecated. This is bad"); + (Error 364, Line 10, Col 16, Line 10, Col 84, "The named argument 'DefaultOptions' has been assigned more than one value"); (Error 101, Line 10, Col 38, Line 10, Col 52, "This construct is deprecated. This is bad") ] From 299a18801d3162cae870c3e90ad6240673c2a7c7 Mon Sep 17 00:00:00 2001 From: Edgar Gonzalez Date: Thu, 28 Mar 2024 14:48:43 +0000 Subject: [PATCH 12/12] even more simpler --- src/Compiler/Checking/CheckExpressions.fs | 12 ++---------- 1 file changed, 2 insertions(+), 10 deletions(-) diff --git a/src/Compiler/Checking/CheckExpressions.fs b/src/Compiler/Checking/CheckExpressions.fs index 63b559fc6f6..06de913a461 100644 --- a/src/Compiler/Checking/CheckExpressions.fs +++ b/src/Compiler/Checking/CheckExpressions.fs @@ -1240,13 +1240,6 @@ let CheckInitProperties (g: TcGlobals) (minfo: MethInfo) methodName mItem = // Check, wheter this method has external init, emit an error diagnostic in this case. if minfo.HasExternalInit then errorR (Error (FSComp.SR.tcSetterForInitOnlyPropertyCannotBeCalled1 methodName, mItem)) - -let CheckPropertyAttributes finalAssignedItemSetters = - for propInfo in finalAssignedItemSetters do - match propInfo with - | AssignedItemSetter(ident, AssignedPropSetter (_, pinfo, _, _), _) -> - CheckPropInfoAttributes pinfo ident.idRange |> CommitOperationResult - | _ -> () let CheckRequiredProperties (g:TcGlobals) (env: TcEnv) (cenv: TcFileState) (minfo: MethInfo) finalAssignedItemSetters mMethExpr = // Make sure, if apparent type has any required properties, they all are in the `finalAssignedItemSetters`. @@ -10093,9 +10086,6 @@ and TcMethodApplication // Handle post-hoc property assignments let setterExprPrebinders, callExpr2b = let expr = callExpr2 - - CheckPropertyAttributes finalAssignedItemSetters - CheckRequiredProperties g env cenv finalCalledMethInfo finalAssignedItemSetters mMethExpr if isCheckingAttributeCall then @@ -10170,6 +10160,8 @@ and TcSetterArgExpr (cenv: cenv) env denv objExpr ad assignedSetter calledFromCo match setter with | AssignedPropSetter (propStaticTyOpt, pinfo, pminfo, pminst) -> + CheckPropInfoAttributes pinfo id.idRange |> CommitOperationResult + if g.langVersion.SupportsFeature(LanguageFeature.RequiredPropertiesSupport) && pinfo.IsSetterInitOnly && not calledFromConstructor then errorR (Error (FSComp.SR.tcInitOnlyPropertyCannotBeSet1 pinfo.PropertyName, m))