Allow access modifiers to auto properties getters and setters (#16687)

* Allow access modifies to auto properties * move types * update release note * Put it under preview flag * add and update baseline * move checks leave parser * update ServiceNavigation; fantomas * add tests * fix tests * fix tests * fix tests * fix tests * fix * fix * fix * fix * add spaces * fix grammar --------- Co-authored-by: Vlad Zarytovskii <[email protected]>
dotnet · Mar 7, 2024 · c4f7bed · c4f7bed
1 parent efa5537
commit c4f7bed
Show file tree

Hide file tree

Showing 52 changed files with 588 additions and 67 deletions.
diff --git a/docs/release-notes/.FSharp.Compiler.Service/8.0.300.md b/docs/release-notes/.FSharp.Compiler.Service/8.0.300.md
@@ -26,6 +26,7 @@
 * Add switch to generate types and members with  IL visibility that accurately represents their F# visibility. ([PR #15484](https://github.com/dotnet/fsharp/pull/15484)
 * Allow returning bool instead of unit option for partial active patterns. ([Language suggestion #1041](https://github.com/fsharp/fslang-suggestions/issues/1041), [PR #16473](https://github.com/dotnet/fsharp/pull/16473))
 * Symbols: Add GenericArguments to FSharpEntity ([PR #16470](https://github.com/dotnet/fsharp/pull/16470))
+* Allow access modifies to auto properties getters and setters ([PR 16687](https://github.com/dotnet/fsharp/pull/16687), [Language suggestion #430](https://github.com/fsharp/fslang-suggestions/issues/430))
 
 ### Changed
 

diff --git a/docs/release-notes/.Language/preview.md b/docs/release-notes/.Language/preview.md
@@ -5,6 +5,7 @@
 * Bidirectional F#/C# interop for 'unmanaged' constraint. ([PR #12154](https://github.com/dotnet/fsharp/pull/12154))
 * Make `.Is*` discriminated union properties visible. ([Language suggestion #222](https://github.com/fsharp/fslang-suggestions/issues/222), [PR #16341](https://github.com/dotnet/fsharp/pull/16341))
 * Allow returning bool instead of unit option for partial active patterns. ([Language suggestion #1041](https://github.com/fsharp/fslang-suggestions/issues/1041), [PR #16473](https://github.com/dotnet/fsharp/pull/16473))
+* Allow access modifies to auto properties getters and setters ([PR 16687](https://github.com/dotnet/fsharp/pull/16687), [Language suggestion #430](https://github.com/fsharp/fslang-suggestions/issues/430))
 
 ### Fixed
 

diff --git a/src/Compiler/Checking/CheckDeclarations.fs b/src/Compiler/Checking/CheckDeclarations.fs
@@ -4309,7 +4309,7 @@ module TcDeclarations =
             | _ -> ()
 
     /// Split auto-properties into 'let' and 'member' bindings
-    let private SplitAutoProps members =
+    let private SplitAutoProps (g: TcGlobals) members =
         let membersIncludingAutoProps, vals_Inherits_Abstractslots = 
             members |> List.partition (fun memb -> 
                 match memb with 
@@ -4359,7 +4359,7 @@ module TcDeclarations =
         let rec postAutoProps memb =
             match memb with 
             | SynMemberDefn.AutoProperty(ident = id) when String.IsNullOrEmpty(id.idText) -> []
-            | SynMemberDefn.AutoProperty(attributes=Attributes attribs; isStatic=isStatic; ident=id; typeOpt=tyOpt; propKind=propKind; memberFlags=memberFlags; memberFlagsForSet=memberFlagsForSet; xmlDoc=xmlDoc; accessibility=access; trivia = { GetSetKeywords = mGetSetOpt }) ->
+            | SynMemberDefn.AutoProperty(attributes=Attributes attribs; isStatic=isStatic; ident=id; typeOpt=tyOpt; propKind=propKind; memberFlags=memberFlags; memberFlagsForSet=memberFlagsForSet; xmlDoc=xmlDoc; trivia = { GetSetKeywords = mGetSetOpt }; accessibility = access; getterAccessibility = getterAccess; setterAccessibility = setterAccess) ->
                 let mMemberPortion = id.idRange
                 // Only the keep the non-field-targeted attributes
                 let attribs = attribs |> List.filter (fun a -> match a.Target with Some t when t.idText = "field" -> false | _ -> true)
@@ -4372,7 +4372,41 @@ module TcDeclarations =
                 match propKind, mGetSetOpt with 
                 | SynMemberKind.PropertySet, Some getSetKeywords -> errorR(Error(FSComp.SR.parsMutableOnAutoPropertyShouldBeGetSetNotJustSet(), getSetKeywords.Range))
                 | _ -> ()
-
+
+                let getterAccess, setterAccess =
+                    match propKind with
+                    | SynMemberKind.PropertyGetSet ->
+                        match access with
+                        | Some _ ->
+                            match getterAccess, setterAccess with
+                            | None, None -> access, access
+                            | Some x, _
+                            | _, Some x -> 
+                                errorR(Error(FSComp.SR.parsMultipleAccessibilitiesForGetSet(), x.Range))
+                                None, None
+                        | None ->
+                            match getterAccess, setterAccess with
+                            | Some x, _
+                            | _, Some x ->
+                                checkLanguageFeatureAndRecover g.langVersion LanguageFeature.AllowAccessModifiersToAutoPropertiesGettersAndSetters x.Range
+                                getterAccess, setterAccess
+                            | _, _ -> None, None
+                    | SynMemberKind.PropertySet ->
+                        match access, setterAccess with
+                        | Some _, Some x -> 
+                            errorR(Error(FSComp.SR.parsMultipleAccessibilitiesForGetSet(), x.Range))
+                            None, None
+                        | _, None -> None, access
+                        | None, _ -> None, setterAccess
+                    | SynMemberKind.Member
+                    | SynMemberKind.PropertyGet
+                    | _ ->
+                        match access, getterAccess with
+                        | Some _, Some x -> 
+                            errorR(Error(FSComp.SR.parsMultipleAccessibilitiesForGetSet(), x.Range))
+                            None, None
+                        | _, None -> access, None
+                        | None, _ -> getterAccess, None
                 [ 
                     match propKind with 
                     | SynMemberKind.Member
@@ -4382,7 +4416,7 @@ module TcDeclarations =
                             let rhsExpr = SynExpr.Ident fldId
                             let retInfo = match tyOpt with None -> None | Some ty -> Some (None, SynReturnInfo((ty, SynInfo.unnamedRetVal), ty.Range))
                             let attribs = mkAttributeList attribs mMemberPortion
-                            let binding = mkSynBinding (xmlDoc, headPat) (access, false, false, mMemberPortion, DebugPointAtBinding.NoneAtInvisible, retInfo, rhsExpr, rhsExpr.Range, [], attribs, Some memberFlags, SynBindingTrivia.Zero)
+                            let binding = mkSynBinding (xmlDoc, headPat) (getterAccess, false, false, mMemberPortion, DebugPointAtBinding.NoneAtInvisible, retInfo, rhsExpr, rhsExpr.Range, [], attribs, Some memberFlags, SynBindingTrivia.Zero)
                             SynMemberDefn.Member (binding, mMemberPortion) 
                         yield getter
                     | _ -> ()
@@ -4394,7 +4428,7 @@ module TcDeclarations =
                             let vId = ident("v", mMemberPortion)
                             let headPat = SynPat.LongIdent (SynLongIdent(headPatIds, [], List.replicate headPatIds.Length None), None, Some noInferredTypars, SynArgPats.Pats [mkSynPatVar None vId], None, mMemberPortion)
                             let rhsExpr = mkSynAssign (SynExpr.Ident fldId) (SynExpr.Ident vId)
-                            let binding = mkSynBinding (xmlDoc, headPat) (access, false, false, mMemberPortion, DebugPointAtBinding.NoneAtInvisible, None, rhsExpr, rhsExpr.Range, [], [], Some memberFlagsForSet, SynBindingTrivia.Zero)
+                            let binding = mkSynBinding (xmlDoc, headPat) (setterAccess, false, false, mMemberPortion, DebugPointAtBinding.NoneAtInvisible, None, rhsExpr, rhsExpr.Range, [], [], Some memberFlagsForSet, SynBindingTrivia.Zero)
                             SynMemberDefn.Member (binding, mMemberPortion)
                         yield setter 
                     | _ -> ()]
@@ -4418,9 +4452,9 @@ module TcDeclarations =
     ///        where simpleRepr can contain inherit type, declared fields and virtual slots.
     /// body = members
     ///        where members contain methods/overrides, also implicit ctor, inheritCall and local definitions.
-    let rec private SplitTyconDefn (SynTypeDefn(typeInfo=synTyconInfo;typeRepr=trepr; members=extraMembers)) =
+    let rec private SplitTyconDefn g (SynTypeDefn(typeInfo=synTyconInfo;typeRepr=trepr; members=extraMembers)) =
         let extraMembers = desugarGetSetMembers extraMembers
-        let extraMembers, extra_vals_Inherits_Abstractslots = SplitAutoProps extraMembers
+        let extraMembers, extra_vals_Inherits_Abstractslots = SplitAutoProps g extraMembers
         let implements1 = extraMembers |> List.choose (function SynMemberDefn.Interface (interfaceType=ty) -> Some(ty, ty.Range) | _ -> None)
 
         match trepr with
@@ -4441,7 +4475,7 @@ module TcDeclarations =
 
             let slotsigs = members |> List.choose (function  SynMemberDefn.AbstractSlot (slotSig = x; flags = y) -> Some(x, y) | _ -> None)
 
-            let members,_vals_Inherits_Abstractslots = SplitAutoProps members
+            let members,_vals_Inherits_Abstractslots = SplitAutoProps g members
 
             let isConcrete = 
                 members |> List.exists (function 
@@ -4503,7 +4537,7 @@ module TcDeclarations =
 
         // Split the definitions into "core representations" and "members". The code to process core representations
         // is shared between processing of signature files and implementation files.
-        let mutRecDefnsAfterSplit = mutRecDefns |> MutRecShapes.mapTycons SplitTyconDefn
+        let mutRecDefnsAfterSplit = mutRecDefns |> MutRecShapes.mapTycons (fun i -> SplitTyconDefn g i)
 
         // Create the entities for each module and type definition, and process the core representation of each type definition.
         let tycons, envMutRecPrelim, mutRecDefnsAfterCore = 

diff --git a/src/Compiler/FSComp.txt b/src/Compiler/FSComp.txt
@@ -1746,4 +1746,6 @@ featureReuseSameFieldsInStructUnions,"Share underlying fields in a [<Struct>] di
 3862,parsStaticMemberImcompleteSyntax,"Incomplete declaration of a static construct. Use 'static let','static do','static member' or 'static val' for declaration."
 3863,parsExpectingField,"Expecting record field"
 3864,tooManyMethodsInDotNetTypeWritingAssembly,"The type '%s' has too many methods. Found: '%d', maximum: '%d'"
-3865,parsOnlySimplePatternsAreAllowedInConstructors,"Only simple patterns are allowed in primary constructors"
+3865,parsOnlySimplePatternsAreAllowedInConstructors,"Only simple patterns are allowed in primary constructors"
+featureAllowAccessModifiersToAutoPropertiesGettersAndSetters,"Allow access modifiers to auto properties getters and setters"
+3866,parsAccessModifiersBeforeGettersAndSettersNotAllowedInSigFile,"The modifier will be ignored because access modifiers before getters and setters are not allowed in signature file."
diff --git a/src/Compiler/Facilities/LanguageFeatures.fs b/src/Compiler/Facilities/LanguageFeatures.fs
@@ -85,6 +85,7 @@ type LanguageFeature =
     | WarningIndexedPropertiesGetSetSameType
     | WarningWhenTailCallAttrOnNonRec
     | BooleanReturningAndReturnTypeDirectedPartialActivePattern
+    | AllowAccessModifiersToAutoPropertiesGettersAndSetters
     | EnforceAttributeTargetsOnFunctions
     | EnforceAttributeTargetsUnionCaseDeclarations
     | LowerInterpolatedStringToConcat
@@ -201,6 +202,7 @@ type LanguageVersion(versionText) =
                 LanguageFeature.WarningWhenTailCallAttrOnNonRec, previewVersion
                 LanguageFeature.UnionIsPropertiesVisible, previewVersion
                 LanguageFeature.BooleanReturningAndReturnTypeDirectedPartialActivePattern, previewVersion
+                LanguageFeature.AllowAccessModifiersToAutoPropertiesGettersAndSetters, previewVersion
                 LanguageFeature.EnforceAttributeTargetsOnFunctions, previewVersion
                 LanguageFeature.EnforceAttributeTargetsUnionCaseDeclarations, previewVersion
                 LanguageFeature.LowerInterpolatedStringToConcat, previewVersion
@@ -348,6 +350,8 @@ type LanguageVersion(versionText) =
         | LanguageFeature.WarningWhenTailCallAttrOnNonRec -> FSComp.SR.featureChkTailCallAttrOnNonRec ()
         | LanguageFeature.BooleanReturningAndReturnTypeDirectedPartialActivePattern ->
             FSComp.SR.featureBooleanReturningAndReturnTypeDirectedPartialActivePattern ()
+        | LanguageFeature.AllowAccessModifiersToAutoPropertiesGettersAndSetters ->
+            FSComp.SR.featureAllowAccessModifiersToAutoPropertiesGettersAndSetters ()
         | LanguageFeature.EnforceAttributeTargetsOnFunctions -> FSComp.SR.featureEnforceAttributeTargetsOnFunctions ()
         | LanguageFeature.EnforceAttributeTargetsUnionCaseDeclarations -> FSComp.SR.featureEnforceAttributeTargetsUnionCaseDeclarations ()
         | LanguageFeature.LowerInterpolatedStringToConcat -> FSComp.SR.featureLowerInterpolatedStringToConcat ()

diff --git a/src/Compiler/Facilities/LanguageFeatures.fsi b/src/Compiler/Facilities/LanguageFeatures.fsi
@@ -76,6 +76,7 @@ type LanguageFeature =
     | WarningIndexedPropertiesGetSetSameType
     | WarningWhenTailCallAttrOnNonRec
     | BooleanReturningAndReturnTypeDirectedPartialActivePattern
+    | AllowAccessModifiersToAutoPropertiesGettersAndSetters
     | EnforceAttributeTargetsOnFunctions
     | EnforceAttributeTargetsUnionCaseDeclarations
     | LowerInterpolatedStringToConcat

diff --git a/src/Compiler/Service/ServiceNavigation.fs b/src/Compiler/Service/ServiceNavigation.fs
@@ -332,9 +332,19 @@ module NavigationImpl =
                          [
                              createMember (rcid, NavigationItemKind.Field, FSharpGlyph.Field, range, enclosingEntityKind, false, access)
                          ]
-                     | SynMemberDefn.AutoProperty(ident = id; accessibility = access) ->
+                     | SynMemberDefn.AutoProperty(
+                         ident = id; accessibility = access; getterAccessibility = getterAccessibility; setterAccessibility = setterAccessibility; propKind = propKind) ->
+                         let getterAccessibility = getterAccessibility |> Option.orElse access
+                         let setterAccessibility = setterAccessibility |> Option.orElse access
+
                          [
-                             createMember (id, NavigationItemKind.Field, FSharpGlyph.Field, id.idRange, enclosingEntityKind, false, access)
+                             match propKind with
+                             | SynMemberKind.PropertyGetSet ->
+                                 yield createMember (id, NavigationItemKind.Field, FSharpGlyph.Field, id.idRange, enclosingEntityKind, false, getterAccessibility)
+                                 yield createMember (id, NavigationItemKind.Field, FSharpGlyph.Field, id.idRange, enclosingEntityKind, false, setterAccessibility)
+                             | SynMemberKind.PropertySet ->
+                                 yield createMember (id, NavigationItemKind.Field, FSharpGlyph.Field, id.idRange, enclosingEntityKind, false, setterAccessibility)
+                             | _ -> yield createMember (id, NavigationItemKind.Field, FSharpGlyph.Field, id.idRange, enclosingEntityKind, false, getterAccessibility)
                          ]
                      | SynMemberDefn.AbstractSlot(slotSig = SynValSig(ident = SynIdent(id, _); synType = ty; accessibility = access)) ->
                          [

diff --git a/src/Compiler/SyntaxTree/ParseHelpers.fs b/src/Compiler/SyntaxTree/ParseHelpers.fs
@@ -1101,7 +1101,7 @@ let mkSynUnionCase attributes (access: SynAccess option) id kind mDecl (xmlDoc,
     SynUnionCase(attributes, id, kind, xmlDoc, None, mDecl, trivia)
 
 let mkAutoPropDefn mVal access ident typ mEquals (expr: SynExpr) accessors xmlDoc attribs flags rangeStart =
-    let mWith, (getSet, getSetOpt) = accessors
+    let mWith, (getSet, getSetOpt, getterAccess, setterAccess) = accessors
 
     let memberRange =
         match getSetOpt with
@@ -1135,6 +1135,8 @@ let mkAutoPropDefn mVal access ident typ mEquals (expr: SynExpr) accessors xmlDo
         memberFlagsForSet,
         xmlDoc,
         access,
+        getterAccess,
+        setterAccess,
         expr,
         memberRange,
         trivia

diff --git a/src/Compiler/SyntaxTree/ParseHelpers.fsi b/src/Compiler/SyntaxTree/ParseHelpers.fsi
@@ -272,7 +272,7 @@ val mkAutoPropDefn:
     typ: SynType option ->
     mEquals: range option ->
     expr: SynExpr ->
-    accessors: range option * (SynMemberKind * GetSetKeywords option) ->
+    accessors: range option * (SynMemberKind * GetSetKeywords option * SynAccess option * SynAccess option) ->
         xmlDoc: PreXmlDoc ->
         attribs: SynAttributes ->
         flags: (SynMemberKind -> SynMemberFlags) * SynLeadingKeyword ->

diff --git a/src/Compiler/SyntaxTree/SyntaxTree.fs b/src/Compiler/SyntaxTree/SyntaxTree.fs
@@ -1463,6 +1463,8 @@ type SynMemberDefn =
         memberFlagsForSet: SynMemberFlags *
         xmlDoc: PreXmlDoc *
         accessibility: SynAccess option *
+        getterAccessibility: SynAccess option *
+        setterAccessibility: SynAccess option *
         synExpr: SynExpr *
         range: range *
         trivia: SynMemberDefnAutoPropertyTrivia

diff --git a/src/Compiler/SyntaxTree/SyntaxTree.fsi b/src/Compiler/SyntaxTree/SyntaxTree.fsi
@@ -1656,6 +1656,8 @@ type SynMemberDefn =
         memberFlagsForSet: SynMemberFlags *
         xmlDoc: PreXmlDoc *
         accessibility: SynAccess option *
+        getterAccessibility: SynAccess option *
+        setterAccessibility: SynAccess option *
         synExpr: SynExpr *
         range: range *
         trivia: SynMemberDefnAutoPropertyTrivia