Allow closures to read a protected base field

docs/release-notes/.Language/preview.md

@@ -3,6 +3,7 @@
 * Warn (FS3884) when a function or delegate value is used as an interpolated string argument, since it will be formatted via `ToString` rather than being applied. ([PR #19289](https://github.com/dotnet/fsharp/pull/19289))
 * Added `MethodOverloadsCache` language feature (preview) that caches overload resolution results for repeated method calls, significantly improving compilation performance. ([PR #19072](https://github.com/dotnet/fsharp/pull/19072))
 * Added `ErrorOnMissingSignatureAttribute` preview language feature: makes FS3888 (compiler-semantic attribute on the `.fs` but not on the `.fsi`) an error instead of a warning. ([Issue #19560](https://github.com/dotnet/fsharp/issues/19560), [PR #19880](https://github.com/dotnet/fsharp/pull/19880))
+* Added `AccessProtectedBaseFieldFromClosure` preview language feature: a derived member can now read a `protected` base-class field from an ordinary closure (lambda, delegate, `async`/`seq`/`lazy`, `function`, or list/array literal), which previously failed with FS1097 even though direct access compiles. Object expressions remain unsupported — bind the field to a local function or expose it through a member. ([Issue #5302](https://github.com/dotnet/fsharp/issues/5302))
 
 ### Fixed
 

src/Compiler/Checking/AccessibilityLogic.fs

@@ -7,6 +7,7 @@ open Internal.Utilities.Library
 open FSharp.Compiler 
 open FSharp.Compiler.AbstractIL.IL 
 open FSharp.Compiler.DiagnosticsLogger
+open FSharp.Compiler.Import
 open FSharp.Compiler.Infos
 open FSharp.Compiler.TcGlobals
 open FSharp.Compiler.TypedTree
@@ -234,6 +235,33 @@ let IsILFieldInfoAccessible g amap m ad x =
         IsProvidedMemberAccessible amap m ad x.ApparentEnclosingType access
 #endif
 
+/// True if the IL field has protected (family) accessibility.
+let private isProtectedILFieldSpec (amap: ImportMap) m (fspec: ILFieldSpec) =
+    match fspec.DeclaringTypeRef with
+    | TryImportILTypeRef amap m (ILTyconRawMetadata tdef) ->
+        tdef.Fields.LookupByName fspec.Name
+        |> List.exists (fun fdef -> fdef.Access = ILMemberAccess.Family || fdef.Access = ILMemberAccess.FamilyOrAssembly)
+    | _ -> false
+
+let exprReferencesProtectedILField (amap: ImportMap) expr =
+    let mutable found = false
+
+    let folder =
+        { ExprFolder0 with
+            exprIntercept =
+                fun _recurseF noInterceptF z e ->
+                    if not found then
+                        match e with
+                        | Expr.Op(TOp.ILAsm(instrs, _), _, _, m) ->
+                            if instrs |> List.exists (function ILFieldInstr fspec -> isProtectedILFieldSpec amap m fspec | _ -> false) then
+                                found <- true
+                        | _ -> ()
+
+                    noInterceptF z e }
+
+    FoldExpr folder () expr |> ignore
+    found
+
 let GetILAccessOfILEventInfo (ILEventInfo (tinfo, edef)) =
     (resolveILMethodRef tinfo.RawMetadata edef.AddMethod).Access 
 

src/Compiler/Checking/AccessibilityLogic.fsi

@@ -69,6 +69,11 @@ val ComputeILAccess:
 
 val IsILFieldInfoAccessible: g: TcGlobals -> amap: ImportMap -> m: range -> ad: AccessorDomain -> x: ILFieldInfo -> bool
 
+/// True if the expression loads, stores, or takes the address of an IL field with protected (Family or
+/// FamilyOrAssembly) access. Such a field may only be reachable from inside the declaring family, so a
+/// closure or lifted helper that references one must not be relocated outside the declaring type (#19963, #5302).
+val exprReferencesProtectedILField: amap: ImportMap -> expr: Expr -> bool
+
 val GetILAccessOfILEventInfo: ILEventInfo -> ILMemberAccess
 
 val IsILEventInfoAccessible:

src/Compiler/Checking/CheckBasics.fs

@@ -236,6 +236,10 @@ type TcEnv =
 
       // Do we lay down an implicit debug point?
       eIsControlFlow: bool
+
+      /// Are we checking the body of an object expression? Such a body has family access to the
+      /// implemented type, but its closures are not nested under that type, so they cannot keep it (#5302).
+      eInObjectExpr: bool
 
       // In order to avoid checking implicit-yield expressions multiple times, we cache the resulting checked expressions.
       // This avoids exponential behavior in the type checker when nesting implicit-yield expressions.

src/Compiler/Checking/CheckBasics.fsi

@@ -130,6 +130,10 @@ type TcEnv =
 
         eIsControlFlow: bool
 
+        /// Are we checking the body of an object expression? Such a body has family access to the
+        /// implemented type, but its closures are not nested under that type, so they cannot keep it (#5302).
+        eInObjectExpr: bool
+
         // In order to avoid checking implicit-yield expressions multiple times, we cache the resulting checked expressions.
         // This avoids exponential behavior in the type checker when nesting implicit-yield expressions.
         eCachedImplicitYieldExpressions: HashMultiMap<range, SynExpr * TType * Expr>

src/Compiler/Checking/CheckDeclarations.fs

@@ -5652,6 +5652,7 @@ let emptyTcEnv g =
       eCallerMemberName = None 
       eLambdaArgInfos = []
       eIsControlFlow = false
+      eInObjectExpr = false
       eCachedImplicitYieldExpressions = HashMultiMap(HashIdentity.Structural, useConcurrentDictionary = true)
       eUseBoundValStamps = Set.empty }
 

src/Compiler/Checking/Expressions/CheckExpressions.fs

@@ -209,6 +209,15 @@ let ExitFamilyRegion env =
 
 let AreWithinCtorShape env = match env.eCtorInfo with None -> false | Some ctorInfo -> ctorInfo.ctorShapeCounter > 0
 
+/// #5302: keep the family region so a protected base field can be read from a closure (it nests under the
+/// declaring type, preserving family access) — except inside an object-expression body, whose closures are
+/// emitted beside the object-expression class rather than within it and so cannot keep family access.
+let KeepFamilyRegionForClosure (g: TcGlobals) env =
+    if g.langVersion.SupportsFeature LanguageFeature.AccessProtectedBaseFieldFromClosure && not env.eInObjectExpr then
+        env
+    else
+        ExitFamilyRegion env
+
 let GetCtorShapeCounter env = match env.eCtorInfo with None -> 0 | Some ctorInfo -> ctorInfo.ctorShapeCounter
 
 let GetRecdInfo env = match env.eCtorInfo with None -> RecdExpr | Some ctorInfo -> if ctorInfo.ctorShapeCounter = 1 then RecdExprIsObjInit else RecdExpr
@@ -6094,12 +6103,12 @@ and TcExprUndelayed (cenv: cenv) (overallTy: OverallTy) env tpenv (synExpr: SynE
         then
             warning (Error(FSComp.SR.chkDeprecatePlacesWhereSeqCanBeOmitted (), m))
 
-        let env = ExitFamilyRegion env
+        let env = KeepFamilyRegionForClosure cenv.g env
         cenv.TcSequenceExpressionEntry cenv env overallTy tpenv (hasSeqBuilder, comp) m
 
     | SynExpr.ArrayOrListComputed (isArray, comp, m) ->
         TcNonControlFlowExpr env <| fun env ->
-        let env = ExitFamilyRegion env
+        let env = KeepFamilyRegionForClosure cenv.g env
         CallExprHasTypeSink cenv.tcSink (m, env.NameEnv, overallTy.Commit, env.eAccessRights)
         cenv.TcArrayOrListComputedExpression cenv env overallTy tpenv (isArray, comp)  m
 
@@ -6250,7 +6259,7 @@ and TcExprMatchLambda (cenv: cenv) overallTy env tpenv (isExnMatch, mFunction, c
     let idv1, idve1 = mkCompGenLocal mFunction (cenv.synArgNameGenerator.New()) domainTy
     CallExprHasTypeSink cenv.tcSink (mFunction.StartRange, env.NameEnv, domainTy, env.AccessRights)
     CallExprHasTypeSink cenv.tcSink (m, env.NameEnv, overallTy.Commit, env.AccessRights)
-    let envinner = ExitFamilyRegion env
+    let envinner = KeepFamilyRegionForClosure cenv.g env
     let envinner = { envinner with eIsControlFlow = true }
     let idv2, matchExpr, tpenv = TcAndPatternCompileMatchClauses m mFunction (if isExnMatch then Throw else ThrowIncompleteMatchException) cenv None domainTy (MustConvertTo (false, resultTy)) envinner tpenv clauses
     let overallExpr = mkMultiLambda m [idv1] ((mkLet spMatch m idv2 idve1 matchExpr), resultTy)
@@ -6315,7 +6324,7 @@ and TcExprLazy (cenv: cenv) overallTy env tpenv (synInnerExpr, m) =
     let g = cenv.g
     let innerTy = NewInferenceType g
     UnifyTypes cenv env m overallTy.Commit (mkLazyTy g innerTy)
-    let envinner = ExitFamilyRegion env
+    let envinner = KeepFamilyRegionForClosure g env
     let envinner = { envinner with eIsControlFlow = true }
     let innerExpr, tpenv = TcExpr cenv (MustEqual innerTy) envinner tpenv synInnerExpr
     let expr = mkLazyDelayed g m innerTy (mkUnitDelayLambda g m innerExpr)
@@ -6641,7 +6650,9 @@ and TcIteratedLambdas (cenv: cenv) isFirst (env: TcEnv) overallTy takenNames tpe
 
         let envinner, _, vspecMap = MakeAndPublishSimpleValsForMergedScope cenv env m names
         let byrefs = vspecMap |> Map.map (fun _ v -> isByrefTy g v.Type, v)
-        let envinner = if isMember then envinner else ExitFamilyRegion envinner
+        // #5302: fields-only — a protected base field read type-checks here; methods/base stay FS0405.
+        let envinner =
+            if isMember then envinner else KeepFamilyRegionForClosure g envinner
         let vspecs = vs |> List.map (fun nm -> NameMap.find nm vspecMap)
 
         // Match up the arginfos with the generated arguments and apply any information extracted from the attributes
@@ -7399,6 +7410,8 @@ and TcObjectExpr (cenv: cenv) env tpenv (objTy, realObjTy, argopt, binds, extraI
 
     // Object expression members can access protected members of the implemented type
     let env = EnterFamilyRegion tcref env
+    // #5302: closures inside an object-expression body cannot keep the family region (see eInObjectExpr).
+    let env = { env with eInObjectExpr = true }
     let ad = env.AccessRights
 
     if // record construction ? e.g { A = 1; B = 2 }

src/Compiler/CodeGen/IlxGen.fs

@@ -9501,25 +9501,25 @@ and GenMethodForBinding
     let m = v.Range
 
     // Closures synthesized inside a member body (inner `let rec`, `task`/`async` state
-    // machines, quotation-splice helpers) are nested in the IL type identified by
-    // eenv.cloc. Under --realsig+ a source-`private` member compiles to IL `private`
-    // (type-scoped), so a closure that calls it must nest inside the declaring type, not
-    // beside it in the module class, or the CLR raises MethodAccessException at runtime.
-    //
-    // Members declared in the type's own definition already reach here with the declaring
-    // type in eenv.cloc, but members declared in an intrinsic augmentation (`type C with
-    // member ...`) reach here with only the enclosing module in scope, because the
-    // augmentation is a separate definition group from the type. Normalize eenv.cloc to the
-    // declaring type for every non-extension member so closure placement is consistent
-    // (idempotent for members that already have it). Real extension members are compiled as
-    // static methods in their own module and must not be re-homed.
-    //
-    // This only matters under --realsig+: with the legacy --realsig- visibility a
-    // module-level sibling closure can still reach the (IL `assembly`) member, so the
-    // placement is left unchanged there to avoid perturbing existing IL.
+    // machines, quotation-splice helpers) nest in the IL type identified by eenv.cloc.
+    // Normalize eenv.cloc to the declaring type so they nest inside it rather than beside it
+    // in the module class, in two cases:
+    //   * under --realsig+, for every non-extension member: a source-`private` member compiles
+    //     to IL `private` (type-scoped), so a sibling-module closure calling it would raise
+    //     MethodAccessException;
+    //   * under --realsig-, only when the body reads a protected base field: the closure would
+    //     otherwise lose family access and raise FieldAccessException (issue #5302).
+    // Members declared in an intrinsic augmentation (`type C with member ...`) reach here with
+    // only the enclosing module in scope, so this also normalizes their placement. Real
+    // extension members compile as static methods in their own module and must not be re-homed.
     let eenv =
         match v.MemberInfo with
-        | Some _ when g.realsig && not v.IsExtensionMember ->
+        | Some _ when
+            not v.IsExtensionMember
+            && (g.realsig
+                || (g.langVersion.SupportsFeature LanguageFeature.AccessProtectedBaseFieldFromClosure
+                    && AccessibilityLogic.exprReferencesProtectedILField cenv.amap methLambdaBody))
+            ->
             let declTref = mspec.MethodRef.DeclaringTypeRef
             AddEnclosingToEnv eenv declTref.Enclosing declTref.Name None
         | _ -> eenv

src/Compiler/Driver/OptimizeInputs.fs

@@ -459,7 +459,7 @@ let ApplyAllOptimizations
         : PhaseRes =
         let file =
             file
-            |> InnerLambdasToTopLevelFuncs.MakeTopLevelRepresentationDecisions ccu tcGlobals
+            |> InnerLambdasToTopLevelFuncs.MakeTopLevelRepresentationDecisions importMap ccu tcGlobals
 
         file, prevPhase
 

src/Compiler/FSComp.txt

@@ -1822,3 +1822,4 @@ featurePreprocessorElif,"#elif preprocessor directive"
 3889,tastNamespaceAndTypeWithSameNameInAssembly,"The namespace '%s' clashes with the type '%s'."
 featureExceptionFieldSerializationSupport,"emit GetObjectData and field-restoring deserialization constructor for exception types"
 featureErrorOnMissingSignatureAttribute,"error (rather than warning) when an enforced compiler-semantic attribute is present in the .fs but missing from the .fsi"
+featureAccessProtectedBaseFieldFromClosure,"Access a protected base-class field from a closure inside a member"

src/Compiler/Facilities/LanguageFeatures.fs

@@ -110,6 +110,7 @@ type LanguageFeature =
     | PreprocessorElif
     | ExceptionFieldSerializationSupport
     | ErrorOnMissingSignatureAttribute
+    | AccessProtectedBaseFieldFromClosure
 
 /// LanguageVersion management
 type LanguageVersion(versionText, ?disabledFeaturesArray: LanguageFeature array) =
@@ -263,6 +264,7 @@ type LanguageVersion(versionText, ?disabledFeaturesArray: LanguageFeature array)
                 LanguageFeature.MethodOverloadsCache, previewVersion // Performance optimization for overload resolution
                 LanguageFeature.ImplicitDIMCoverage, languageVersion110
                 LanguageFeature.ErrorOnMissingSignatureAttribute, previewVersion // Opt-in: turn FS3888 from warning into error
+                LanguageFeature.AccessProtectedBaseFieldFromClosure, previewVersion // #5302: read a protected base field from a closure
             ]
 
     static let defaultLanguageVersion = LanguageVersion("default")
@@ -459,6 +461,7 @@ type LanguageVersion(versionText, ?disabledFeaturesArray: LanguageFeature array)
         | LanguageFeature.PreprocessorElif -> FSComp.SR.featurePreprocessorElif ()
         | LanguageFeature.ExceptionFieldSerializationSupport -> FSComp.SR.featureExceptionFieldSerializationSupport ()
         | LanguageFeature.ErrorOnMissingSignatureAttribute -> FSComp.SR.featureErrorOnMissingSignatureAttribute ()
+        | LanguageFeature.AccessProtectedBaseFieldFromClosure -> FSComp.SR.featureAccessProtectedBaseFieldFromClosure ()
 
     /// Get a version string associated with the given feature.
     static member GetFeatureVersionString feature =

src/Compiler/Facilities/LanguageFeatures.fsi

@@ -101,6 +101,7 @@ type LanguageFeature =
     | PreprocessorElif
     | ExceptionFieldSerializationSupport
     | ErrorOnMissingSignatureAttribute
+    | AccessProtectedBaseFieldFromClosure
 
 /// LanguageVersion management
 type LanguageVersion =

src/Compiler/Optimize/InnerLambdasToTopLevelFuncs.fs

@@ -6,9 +6,11 @@ open Internal.Utilities.Collections
 open Internal.Utilities.Library
 open Internal.Utilities.Library.Extras
 open FSharp.Compiler.AbstractIL.Diagnostics
+open FSharp.Compiler.AccessibilityLogic
 open FSharp.Compiler.CompilerGlobalState
 open FSharp.Compiler.Detuple.GlobalUsageAnalysis
 open FSharp.Compiler.DiagnosticsLogger
+open FSharp.Compiler.Features
 open FSharp.Compiler.Syntax
 open FSharp.Compiler.Text
 open FSharp.Compiler.Text.Layout
@@ -204,7 +206,7 @@ module Pass1_DetermineTLRAndArities =
        | Some sites ->
            sites |> List.map (fun (_accessors, _tinst, args) -> List.length args) |> List.max
 
-    let SelectTLRVals g xinfo f e =
+    let SelectTLRVals amap g xinfo f e =
         if IsRefusedTLR g f then
             None
 
@@ -216,6 +218,14 @@ module Pass1_DetermineTLRAndArities =
         // any source-`private` members it references, producing MethodAccessException at runtime.
         elif g.realsig && BodyReferencesTypeScopedPrivate e then
             None
+
+        // #5302: a module-level static lifted out of its family would lose access to a protected base
+        // field (FieldAccessException), so refuse the lift.
+        elif
+            g.langVersion.SupportsFeature LanguageFeature.AccessProtectedBaseFieldFromClosure
+            && exprReferencesProtectedILField amap e
+        then
+            None
         else
             // Could the binding be TLR? with what arity?
             let atTopLevel = Zset.contains f xinfo.TopLevelBindings
@@ -240,9 +250,9 @@ module Pass1_DetermineTLRAndArities =
         let dump f n = dprintf "tlr: arity %50s = %d\n" (showL (valL f)) n
         Zmap.iter dump arityM
 
-    let DetermineTLRAndArities g expr =
+    let DetermineTLRAndArities amap g expr =
        let xinfo = GetUsageInfoOfImplFile g expr
-       let fArities = Zmap.chooseL (SelectTLRVals g xinfo) xinfo.Defns
+       let fArities = Zmap.chooseL (SelectTLRVals amap g xinfo) xinfo.Defns
        let fArities = List.filter (fst >> IsValueRecursionFree xinfo) fArities
        // Do not TLR v if it is bound under a shouldinline defn
        // There is simply no point - the original value will be duplicated and TLR'd anyway
@@ -1372,10 +1382,10 @@ let RecreateUniqueBounds g expr =
 // entry point
 //-------------------------------------------------------------------------
 
-let MakeTopLevelRepresentationDecisions ccu g expr =
+let MakeTopLevelRepresentationDecisions amap ccu g expr =
    try
       // pass1: choose the f to be TLR with arity(f)
-      let tlrS, topValS, arityM = Pass1_DetermineTLRAndArities.DetermineTLRAndArities g expr
+      let tlrS, topValS, arityM = Pass1_DetermineTLRAndArities.DetermineTLRAndArities amap g expr
 
       // pass2: determine the typar/freevar closures, f->fclass and fclass declist
       let reqdItemsMap, fclassM, declist, recShortCallS = Pass2_DetermineReqdItems.DetermineReqdItems (tlrS, arityM) expr

src/Compiler/Optimize/InnerLambdasToTopLevelFuncs.fsi

@@ -2,7 +2,9 @@
 
 module internal FSharp.Compiler.InnerLambdasToTopLevelFuncs
 
+open FSharp.Compiler.Import
 open FSharp.Compiler.TypedTree
 open FSharp.Compiler.TcGlobals
 
-val MakeTopLevelRepresentationDecisions: CcuThunk -> TcGlobals -> CheckedImplFile -> CheckedImplFile
+val MakeTopLevelRepresentationDecisions:
+    amap: ImportMap -> ccu: CcuThunk -> g: TcGlobals -> expr: CheckedImplFile -> CheckedImplFile