Merge pull request #17523 from dotnet/merges/main-to-release/dev17.12

Merge main to release/dev17.12
dotnet · Aug 13, 2024 · 0c76473 · 0c76473
2 parents 7f3176d + 4807859
commit 0c76473
Show file tree

Hide file tree

Showing 133 changed files with 1,164 additions and 311 deletions.
diff --git a/docs/release-notes/.FSharp.Compiler.Service/9.0.100.md b/docs/release-notes/.FSharp.Compiler.Service/9.0.100.md
@@ -15,6 +15,7 @@
 * Parser: recover on missing union case fields (PR [#17452](https://github.com/dotnet/fsharp/pull/17452))
 * Parser: recover on missing union case field types (PR [#17455](https://github.com/dotnet/fsharp/pull/17455))
 * Sink: report function domain type ([PR #17470](https://github.com/dotnet/fsharp/pull/17470))
+* Allow access modifies to auto properties getters and setters ([PR 16687](https://github.com/dotnet/fsharp/pull/16687), [PR 16861](https://github.com/dotnet/fsharp/pull/16861), [Language suggestion #430](https://github.com/fsharp/fslang-suggestions/issues/430))
 * Render C# nullable-analysis attributes in tooltips ([PR #17485](https://github.com/dotnet/fsharp/pull/17485))
 
 ### Changed

diff --git a/docs/release-notes/.Language/preview.md b/docs/release-notes/.Language/preview.md
@@ -7,6 +7,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), [PR 16861](https://github.com/dotnet/fsharp/pull/16861), [Language suggestion #430](https://github.com/fsharp/fslang-suggestions/issues/430))
 * Allow #nowarn to support the FS prefix on error codes to disable warnings ([Issue #17206](https://github.com/dotnet/fsharp/issues/16447), [PR #17209](https://github.com/dotnet/fsharp/pull/17209))
 * Allow ParsedHashDirectives to have argument types other than strings ([Issue #17240](https://github.com/dotnet/fsharp/issues/16447), [PR #17209](https://github.com/dotnet/fsharp/pull/17209))
 * Support empty-bodied computation expressions. ([Language suggestion #1232](https://github.com/fsharp/fslang-suggestions/issues/1232), [PR #17352](https://github.com/dotnet/fsharp/pull/17352))

diff --git a/src/Compiler/Checking/CheckDeclarations.fs b/src/Compiler/Checking/CheckDeclarations.fs
@@ -4325,7 +4325,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 
@@ -4375,7 +4375,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) ->
                 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)
@@ -4388,7 +4388,8 @@ module TcDeclarations =
                 match propKind, mGetSetOpt with 
                 | SynMemberKind.PropertySet, Some getSetKeywords -> errorR(Error(FSComp.SR.parsMutableOnAutoPropertyShouldBeGetSetNotJustSet(), getSetKeywords.Range))
                 | _ -> ()
-
+
+                let getterAccess, setterAccess = getGetterSetterAccess access propKind g.langVersion
                 [ 
                     match propKind with 
                     | SynMemberKind.Member
@@ -4398,7 +4399,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
                     | _ -> ()
@@ -4410,7 +4411,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 
                     | _ -> ()]
@@ -4434,9 +4435,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
@@ -4457,7 +4458,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 
@@ -4519,7 +4520,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/Checking/Expressions/CheckExpressions.fs b/src/Compiler/Checking/Expressions/CheckExpressions.fs
@@ -4132,6 +4132,20 @@ and TcPseudoMemberSpec cenv newOk env synTypes tpenv synMemberSig m =
         let members, tpenv = TcValSpec cenv env ModuleOrMemberBinding newOk ExprContainerInfo (Some memberFlags) (Some (List.head tys)) tpenv synValSig []
         match members with
         | [ValSpecResult(_, _, id, _, _, memberConstraintTy, prelimValReprInfo, _)] ->
+
+            match synValSig with
+            | SynValSig(accessibility = access) ->
+                match access with
+                | SynValSigAccess.Single(Some access)
+                | SynValSigAccess.GetSet(Some access, _, _)
+                | SynValSigAccess.GetSet(_, Some access, _)
+                | SynValSigAccess.GetSet(_, _, Some access) ->
+                    if g.langVersion.SupportsFeature(LanguageFeature.AllowAccessModifiersToAutoPropertiesGettersAndSetters) then
+                        errorR(Error(FSComp.SR.tcAccessModifiersNotAllowedInSRTPConstraint(), access.Range))
+                    else
+                        warning(Error(FSComp.SR.tcAccessModifiersNotAllowedInSRTPConstraint(), access.Range))
+                | _ -> ()
+
             let memberConstraintTypars, _ = tryDestForallTy g memberConstraintTy
             let valReprInfo = TranslatePartialValReprInfo memberConstraintTypars prelimValReprInfo
             let _, _, curriedArgInfos, returnTy, _ = GetValReprTypeInCompiledForm g valReprInfo 0 memberConstraintTy m
@@ -12702,8 +12716,22 @@ let TcAndPublishValSpec (cenv: cenv, env, containerInfo: ContainerInfo, declKind
 
     let valinfos, tpenv = TcValSpec cenv env declKind newOk containerInfo memFlagsOpt None tpenv synValSig attrs
     let denv = env.DisplayEnv
+    let viss = 
+        match memFlagsOpt with
+        | Some ({MemberKind = SynMemberKind.PropertyGetSet as propKind}) ->
+            let getterAccess, setterAccess = getGetterSetterAccess vis propKind g.langVersion
+            List.init valinfos.Length (fun i -> if i = 0 then getterAccess else setterAccess)
+        | Some ({MemberKind = SynMemberKind.PropertyGet as propKind}) ->
+            let getterAccess, _ = getGetterSetterAccess vis propKind g.langVersion
+            List.init valinfos.Length (fun _ -> getterAccess)
+        | Some ({MemberKind = SynMemberKind.PropertySet as propKind}) ->
+            let _, setterAccess = getGetterSetterAccess vis propKind g.langVersion
+            List.init valinfos.Length (fun _ -> setterAccess)
+        | _ ->
+            List.init valinfos.Length (fun _ -> vis.SingleAccess())
+    let valinfos = List.zip valinfos viss
 
-    (tpenv, valinfos) ||> List.mapFold (fun tpenv valSpecResult ->
+    (tpenv, valinfos) ||> List.mapFold (fun tpenv (valSpecResult, vis) ->
 
         let (ValSpecResult (altActualParent, memberInfoOpt, id, enclosingDeclaredTypars, declaredTypars, ty, prelimValReprInfo, declKind)) = valSpecResult