From f7940f06ad33c8223519d849dc4d18c682ab1ab3 Mon Sep 17 00:00:00 2001 From: T-Gro Date: Wed, 24 Jun 2026 10:38:14 +0200 Subject: [PATCH] Enable reading a protected base field from a closure (#5302) Co-authored-by: Copilot <223556219+Copilot@users.noreply.github.com> --- docs/release-notes/.Language/preview.md | 1 + src/Compiler/Checking/AccessibilityLogic.fs | 28 ++++ src/Compiler/Checking/AccessibilityLogic.fsi | 5 + src/Compiler/Checking/CheckBasics.fs | 4 + src/Compiler/Checking/CheckBasics.fsi | 4 + src/Compiler/Checking/CheckDeclarations.fs | 1 + .../Checking/Expressions/CheckExpressions.fs | 23 ++- src/Compiler/CodeGen/IlxGen.fs | 34 ++--- src/Compiler/Driver/OptimizeInputs.fs | 2 +- src/Compiler/FSComp.txt | 1 + src/Compiler/Facilities/LanguageFeatures.fs | 3 + src/Compiler/Facilities/LanguageFeatures.fsi | 1 + .../Optimize/InnerLambdasToTopLevelFuncs.fs | 20 ++- .../Optimize/InnerLambdasToTopLevelFuncs.fsi | 4 +- src/Compiler/Optimize/Optimizer.fs | 30 +--- src/Compiler/xlf/FSComp.txt.cs.xlf | 5 + src/Compiler/xlf/FSComp.txt.de.xlf | 5 + src/Compiler/xlf/FSComp.txt.es.xlf | 5 + src/Compiler/xlf/FSComp.txt.fr.xlf | 5 + src/Compiler/xlf/FSComp.txt.it.xlf | 5 + src/Compiler/xlf/FSComp.txt.ja.xlf | 5 + src/Compiler/xlf/FSComp.txt.ko.xlf | 5 + src/Compiler/xlf/FSComp.txt.pl.xlf | 5 + src/Compiler/xlf/FSComp.txt.pt-BR.xlf | 5 + src/Compiler/xlf/FSComp.txt.ru.xlf | 5 + src/Compiler/xlf/FSComp.txt.tr.xlf | 5 + src/Compiler/xlf/FSComp.txt.zh-Hans.xlf | 5 + src/Compiler/xlf/FSComp.txt.zh-Hant.xlf | 5 + .../OnTypeMembers/BaseClass.cs | 2 + .../OnTypeMembers/OnTypeMembers.fs | 136 ++++++++++++++++++ 30 files changed, 306 insertions(+), 58 deletions(-) diff --git a/docs/release-notes/.Language/preview.md b/docs/release-notes/.Language/preview.md index 90c1aa2faa6..23df5e77164 100644 --- a/docs/release-notes/.Language/preview.md +++ b/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 diff --git a/src/Compiler/Checking/AccessibilityLogic.fs b/src/Compiler/Checking/AccessibilityLogic.fs index 4995095a688..f63a9f7872e 100644 --- a/src/Compiler/Checking/AccessibilityLogic.fs +++ b/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 diff --git a/src/Compiler/Checking/AccessibilityLogic.fsi b/src/Compiler/Checking/AccessibilityLogic.fsi index fb51c1a101f..3f05f0d1417 100644 --- a/src/Compiler/Checking/AccessibilityLogic.fsi +++ b/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: diff --git a/src/Compiler/Checking/CheckBasics.fs b/src/Compiler/Checking/CheckBasics.fs index ebc842db685..ec116f9d113 100644 --- a/src/Compiler/Checking/CheckBasics.fs +++ b/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. diff --git a/src/Compiler/Checking/CheckBasics.fsi b/src/Compiler/Checking/CheckBasics.fsi index f5685bb9227..02c31776e88 100644 --- a/src/Compiler/Checking/CheckBasics.fsi +++ b/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 diff --git a/src/Compiler/Checking/CheckDeclarations.fs b/src/Compiler/Checking/CheckDeclarations.fs index b7cc8c69028..0fcb17bc574 100644 --- a/src/Compiler/Checking/CheckDeclarations.fs +++ b/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 } diff --git a/src/Compiler/Checking/Expressions/CheckExpressions.fs b/src/Compiler/Checking/Expressions/CheckExpressions.fs index e295bb7a6eb..0ff8fb2ff53 100644 --- a/src/Compiler/Checking/Expressions/CheckExpressions.fs +++ b/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 } diff --git a/src/Compiler/CodeGen/IlxGen.fs b/src/Compiler/CodeGen/IlxGen.fs index 9d56c2cec68..12909913d25 100644 --- a/src/Compiler/CodeGen/IlxGen.fs +++ b/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 diff --git a/src/Compiler/Driver/OptimizeInputs.fs b/src/Compiler/Driver/OptimizeInputs.fs index 78bca4bf979..4b46463fab2 100644 --- a/src/Compiler/Driver/OptimizeInputs.fs +++ b/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 diff --git a/src/Compiler/FSComp.txt b/src/Compiler/FSComp.txt index d29b5d3dde7..50b7a203cf9 100644 --- a/src/Compiler/FSComp.txt +++ b/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" diff --git a/src/Compiler/Facilities/LanguageFeatures.fs b/src/Compiler/Facilities/LanguageFeatures.fs index da4ef690311..c37dea9efce 100644 --- a/src/Compiler/Facilities/LanguageFeatures.fs +++ b/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 = diff --git a/src/Compiler/Facilities/LanguageFeatures.fsi b/src/Compiler/Facilities/LanguageFeatures.fsi index 5ba352191af..7f88d93f709 100644 --- a/src/Compiler/Facilities/LanguageFeatures.fsi +++ b/src/Compiler/Facilities/LanguageFeatures.fsi @@ -101,6 +101,7 @@ type LanguageFeature = | PreprocessorElif | ExceptionFieldSerializationSupport | ErrorOnMissingSignatureAttribute + | AccessProtectedBaseFieldFromClosure /// LanguageVersion management type LanguageVersion = diff --git a/src/Compiler/Optimize/InnerLambdasToTopLevelFuncs.fs b/src/Compiler/Optimize/InnerLambdasToTopLevelFuncs.fs index 0e2d1ede692..2673715141f 100644 --- a/src/Compiler/Optimize/InnerLambdasToTopLevelFuncs.fs +++ b/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 diff --git a/src/Compiler/Optimize/InnerLambdasToTopLevelFuncs.fsi b/src/Compiler/Optimize/InnerLambdasToTopLevelFuncs.fsi index 5a745306764..001c3d7bbd5 100644 --- a/src/Compiler/Optimize/InnerLambdasToTopLevelFuncs.fsi +++ b/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 diff --git a/src/Compiler/Optimize/Optimizer.fs b/src/Compiler/Optimize/Optimizer.fs index ae71bf0811f..56fa49ad327 100644 --- a/src/Compiler/Optimize/Optimizer.fs +++ b/src/Compiler/Optimize/Optimizer.fs @@ -1415,40 +1415,12 @@ let AbstractOptimizationInfoToEssentials = abstractLazyModulInfo -/// True if the IL field has protected (family) accessibility. -let private isProtectedILFieldSpec cenv m (fspec: ILFieldSpec) = - match fspec.DeclaringTypeRef with - | Import.TryImportILTypeRef cenv.amap m (ILTyconRawMetadata tdef) -> - tdef.Fields.LookupByName fspec.Name - |> List.exists (fun fdef -> fdef.Access = ILMemberAccess.Family || fdef.Access = ILMemberAccess.FamilyOrAssembly) - | _ -> false - -/// True if the expression loads or stores a protected (family) IL field anywhere in its body. -let private exprReferencesProtectedILField cenv 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 cenv m fspec | _ -> false) then - found <- true - | _ -> () - - noInterceptF z e } - - FoldExpr folder () expr |> ignore - found - /// True if the expression references constructs that are only valid within their defining method or /// family, and so must not be relocated by inlining or method-splitting: a protected/base call /// (UsesMethodLocalConstructs) or a protected (family) IL field access (issue #19963). let usesMethodLocalConstructsOrProtectedField cenv (fvs: FreeVars) expr = fvs.UsesMethodLocalConstructs - || (fvs.ContainsILFieldAccess && exprReferencesProtectedILField cenv expr) + || (fvs.ContainsILFieldAccess && AccessibilityLogic.exprReferencesProtectedILField cenv.amap expr) /// Hide information because of a "let ... in ..." or "let rec ... in ... " let AbstractExprInfoByVars cenv (boundVars: Val list, boundTyVars) ivalue = diff --git a/src/Compiler/xlf/FSComp.txt.cs.xlf b/src/Compiler/xlf/FSComp.txt.cs.xlf index 3ea52c5b169..a21234e5705 100644 --- a/src/Compiler/xlf/FSComp.txt.cs.xlf +++ b/src/Compiler/xlf/FSComp.txt.cs.xlf @@ -272,6 +272,11 @@ {0} for F# {1} + + Access a protected base-class field from a closure inside a member + Access a protected base-class field from a closure inside a member + + underscore dot shorthand for accessor only function zkrácený tvar podtržítka pouze pro funkci přístupový objekt diff --git a/src/Compiler/xlf/FSComp.txt.de.xlf b/src/Compiler/xlf/FSComp.txt.de.xlf index f9fc62909ef..389b7e3b958 100644 --- a/src/Compiler/xlf/FSComp.txt.de.xlf +++ b/src/Compiler/xlf/FSComp.txt.de.xlf @@ -272,6 +272,11 @@ {0} for F# {1} + + Access a protected base-class field from a closure inside a member + Access a protected base-class field from a closure inside a member + + underscore dot shorthand for accessor only function Unterstrich-Punkt-Kurzschreibweise für Accessorfunktion diff --git a/src/Compiler/xlf/FSComp.txt.es.xlf b/src/Compiler/xlf/FSComp.txt.es.xlf index eca7c688eed..eecad57e04c 100644 --- a/src/Compiler/xlf/FSComp.txt.es.xlf +++ b/src/Compiler/xlf/FSComp.txt.es.xlf @@ -272,6 +272,11 @@ {0} for F# {1} + + Access a protected base-class field from a closure inside a member + Access a protected base-class field from a closure inside a member + + underscore dot shorthand for accessor only function forma abreviada de punto y guion bajo para la función de solo descriptor de acceso diff --git a/src/Compiler/xlf/FSComp.txt.fr.xlf b/src/Compiler/xlf/FSComp.txt.fr.xlf index 0922cee5acd..984bacc2644 100644 --- a/src/Compiler/xlf/FSComp.txt.fr.xlf +++ b/src/Compiler/xlf/FSComp.txt.fr.xlf @@ -272,6 +272,11 @@ {0} for F# {1} + + Access a protected base-class field from a closure inside a member + Access a protected base-class field from a closure inside a member + + underscore dot shorthand for accessor only function raccourci de point de soulignement pour la fonction d'accesseur uniquement diff --git a/src/Compiler/xlf/FSComp.txt.it.xlf b/src/Compiler/xlf/FSComp.txt.it.xlf index d39f0a33a85..6e4b8d20e3a 100644 --- a/src/Compiler/xlf/FSComp.txt.it.xlf +++ b/src/Compiler/xlf/FSComp.txt.it.xlf @@ -272,6 +272,11 @@ {0} for F# {1} + + Access a protected base-class field from a closure inside a member + Access a protected base-class field from a closure inside a member + + underscore dot shorthand for accessor only function sintassi abbreviata del punto di sottolineatura solo per la funzione di accesso diff --git a/src/Compiler/xlf/FSComp.txt.ja.xlf b/src/Compiler/xlf/FSComp.txt.ja.xlf index 6f4969e8148..94204dba55f 100644 --- a/src/Compiler/xlf/FSComp.txt.ja.xlf +++ b/src/Compiler/xlf/FSComp.txt.ja.xlf @@ -272,6 +272,11 @@ {0} for F# {1} + + Access a protected base-class field from a closure inside a member + Access a protected base-class field from a closure inside a member + + underscore dot shorthand for accessor only function アクセサー専用関数のアンダースコア ドット短縮形 diff --git a/src/Compiler/xlf/FSComp.txt.ko.xlf b/src/Compiler/xlf/FSComp.txt.ko.xlf index fb488a6c240..30a49a2ab20 100644 --- a/src/Compiler/xlf/FSComp.txt.ko.xlf +++ b/src/Compiler/xlf/FSComp.txt.ko.xlf @@ -272,6 +272,11 @@ {0} for F# {1} + + Access a protected base-class field from a closure inside a member + Access a protected base-class field from a closure inside a member + + underscore dot shorthand for accessor only function 접근자 전용 함수에 대한 밑줄 점 약어 diff --git a/src/Compiler/xlf/FSComp.txt.pl.xlf b/src/Compiler/xlf/FSComp.txt.pl.xlf index 2720c59fc22..64606b6fdc2 100644 --- a/src/Compiler/xlf/FSComp.txt.pl.xlf +++ b/src/Compiler/xlf/FSComp.txt.pl.xlf @@ -272,6 +272,11 @@ {0} for F# {1} + + Access a protected base-class field from a closure inside a member + Access a protected base-class field from a closure inside a member + + underscore dot shorthand for accessor only function skrót podkreślenia kropki dla funkcji tylko metody dostępu diff --git a/src/Compiler/xlf/FSComp.txt.pt-BR.xlf b/src/Compiler/xlf/FSComp.txt.pt-BR.xlf index 8fc5566545f..1e85d678099 100644 --- a/src/Compiler/xlf/FSComp.txt.pt-BR.xlf +++ b/src/Compiler/xlf/FSComp.txt.pt-BR.xlf @@ -272,6 +272,11 @@ {0} for F# {1} + + Access a protected base-class field from a closure inside a member + Access a protected base-class field from a closure inside a member + + underscore dot shorthand for accessor only function sublinhado ponto abreviação para função somente acessador diff --git a/src/Compiler/xlf/FSComp.txt.ru.xlf b/src/Compiler/xlf/FSComp.txt.ru.xlf index 16eb9766b81..bfa4d9352b6 100644 --- a/src/Compiler/xlf/FSComp.txt.ru.xlf +++ b/src/Compiler/xlf/FSComp.txt.ru.xlf @@ -272,6 +272,11 @@ {0} for F# {1} + + Access a protected base-class field from a closure inside a member + Access a protected base-class field from a closure inside a member + + underscore dot shorthand for accessor only function символ подчеркивания, сокращение точки для функции только для метода доступа diff --git a/src/Compiler/xlf/FSComp.txt.tr.xlf b/src/Compiler/xlf/FSComp.txt.tr.xlf index da5fd475a81..d6f58eb159f 100644 --- a/src/Compiler/xlf/FSComp.txt.tr.xlf +++ b/src/Compiler/xlf/FSComp.txt.tr.xlf @@ -272,6 +272,11 @@ {0} for F# {1} + + Access a protected base-class field from a closure inside a member + Access a protected base-class field from a closure inside a member + + underscore dot shorthand for accessor only function yalnızca erişimci işlevi için alt çizgi nokta kısaltma diff --git a/src/Compiler/xlf/FSComp.txt.zh-Hans.xlf b/src/Compiler/xlf/FSComp.txt.zh-Hans.xlf index c43aa519603..b7fb66bee4e 100644 --- a/src/Compiler/xlf/FSComp.txt.zh-Hans.xlf +++ b/src/Compiler/xlf/FSComp.txt.zh-Hans.xlf @@ -272,6 +272,11 @@ {0} for F# {1} + + Access a protected base-class field from a closure inside a member + Access a protected base-class field from a closure inside a member + + underscore dot shorthand for accessor only function 用于仅存取器函数的下划线点速记 diff --git a/src/Compiler/xlf/FSComp.txt.zh-Hant.xlf b/src/Compiler/xlf/FSComp.txt.zh-Hant.xlf index d287b294184..11af07a244c 100644 --- a/src/Compiler/xlf/FSComp.txt.zh-Hant.xlf +++ b/src/Compiler/xlf/FSComp.txt.zh-Hant.xlf @@ -272,6 +272,11 @@ {0} for F# {1} + + Access a protected base-class field from a closure inside a member + Access a protected base-class field from a closure inside a member + + underscore dot shorthand for accessor only function 僅存取子函式的底線點速記 diff --git a/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/AccessibilityAnnotations/OnTypeMembers/BaseClass.cs b/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/AccessibilityAnnotations/OnTypeMembers/BaseClass.cs index 6ea3b5a9269..9d7279c5181 100644 --- a/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/AccessibilityAnnotations/OnTypeMembers/BaseClass.cs +++ b/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/AccessibilityAnnotations/OnTypeMembers/BaseClass.cs @@ -6,5 +6,7 @@ public class BaseClass protected int ProtectedInstance() { return 4; } protected string ProtectedField = "protected-field"; protected static string ProtectedStaticField = "protected-static-field"; + protected int ProtectedIntField = 42; + protected internal string ProtectedInternalField = "protected-internal-field"; } } \ No newline at end of file diff --git a/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/AccessibilityAnnotations/OnTypeMembers/OnTypeMembers.fs b/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/AccessibilityAnnotations/OnTypeMembers/OnTypeMembers.fs index 5a6de3ecfc4..8d2a4ae9245 100644 --- a/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/AccessibilityAnnotations/OnTypeMembers/OnTypeMembers.fs +++ b/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/AccessibilityAnnotations/OnTypeMembers/OnTypeMembers.fs @@ -125,6 +125,142 @@ let main _ = |> compileAndRun |> shouldSucceed + // ── issue #5302: read a protected base field from a closure in a derived member ── + // A `module Test` with a derived class whose body is `body`, plus an optional `tail` (e.g. an entry point). + let private derivedSourceTemplate = """ +module Test +open TestBaseClass +type DerivedClass() = + inherit BaseClass() + __BODY__ +__TAIL__ +""" + + let private derivedSource body tail = + derivedSourceTemplate.Replace("__BODY__", body).Replace("__TAIL__", tail) + + // A runnable program whose DerivedClass.Run() body is `expr`, with an entry point asserting `expected`. + let private derivedReturning (expr: string) (expected: string) = + derivedSource ("member x.Run() = " + expr) ("[]\nlet main _ = if DerivedClass().Run() = \"" + expected + "\" then 0 else 1") + + // A compile-only program with an extra member/binding `body` (for rejection tests). + let private derivedMember body = derivedSource body "" + + // Compile and run `src` under the feature (--langversion:preview, --realsig- so a surviving closure is + // placed by L2 rather than left in the module), tuning the pipeline with `tune` (e.g. optimization level). + let private runsTuned tune src = + FSharp src |> withReferences [baseClassLib] |> withLangVersionPreview |> withRealInternalSignatureOff |> tune |> asExe |> compileAndRun |> shouldSucceed + + let private runsPreview src = runsTuned withOptimize src + + // Compile `src` at the language level set by `setLang`; assert it is rejected with a message matching `diag`. + let private rejectedAt setLang diag src = + FSharp src |> withReferences [baseClassLib] |> setLang |> compile |> shouldFail |> withDiagnosticMessageMatches diag + + let private rejectedPreview diag src = rejectedAt withLangVersionPreview diag src + + // Every ordinary closure shape can read a protected base field. Run under --realsig- (so the closure is + // placed by L2, not left in the module) and --optimize+ (so a recursive closure exercises the L3 TLR-lift + // refusal); easier realsig/optimize modes are strictly less demanding. + [] + [ x.ProtectedField) ()", "protected-field")>] + [] + [(fun () -> x.ProtectedField).Invoke()", "protected-field")>] + [ Async.RunSynchronously", "protected-field")>] + [] + [ Seq.head", "protected-field")>] + [ x.ProtectedField | _ -> \"\") true", "protected-field")>] + [] + [ List.head", "protected-field")>] + [ Array.head", "protected-field")>] + [] + [] + [] + [] + let ``Protected base field read from a closure runs (issue 5302)`` (expr: string) (expected: string) = + runsPreview (derivedReturning expr expected) + + // L2 in isolation: under --optimize- the closure survives un-inlined and must still nest in the declaring + // type, or the relocated field load throws FieldAccessException at runtime. + [] + let ``Protected base field from a closure nests in the declaring type under optimize- (issue 5302)`` () = + derivedReturning "let f () = x.ProtectedField in f ()" "protected-field" + |> runsTuned (withOptimization false) + + // The closure carries the type parameter of a generic derived type (the lift is refused, not re-homed + // into the generic type — see issues #17607 / #14492). + [] + let ``Protected base field from a closure in a generic derived type runs (issue 5302)`` () = + """ +open TestBaseClass +type DerivedClass<'T>(seed: 'T) = + inherit BaseClass() + member x.Run() = let rec f n = if n = 0 then x.ProtectedField + string (box seed) else f (n - 1) in f 3 +[] +let main _ = if DerivedClass(7).Run() = "protected-field7" then 0 else 1 +""" + |> runsPreview + + // A *direct* protected base field read in an object expression deriving from BaseClass is fine — the + // override method is on the object-expression class, which has family access. Only closures are excluded. + [] + let ``Protected base field read directly in an object expression runs (issue 5302)`` () = + """ +open TestBaseClass +let make () = { new BaseClass() with override this.ToString() = this.ProtectedField } +[] +let main _ = if (make ()).ToString() = "protected-field" then 0 else 1 +""" + |> runsPreview + + // Precision: the gate narrows to *protected* fields, not any IL field. A recursive closure reading a + // PUBLIC field (System.String.Empty) must still be lifted to a module-level static under --optimize+, so + // the lifted static `Test::f@` is present (a closure class would be `Test/f@`). + [] + let ``Public field in a recursive closure is still lifted under the feature (issue 5302)`` () = + FSharp """ +module Test +type Holder() = + member _.Run() = + let rec f n = if n = 0 then System.String.Empty else f (n - 1) + f 4 +""" + |> withLangVersionPreview + |> withOptimize + |> compile + |> shouldSucceed + |> verifyILPresent ["Test::f@"] + + // Fields only: a protected *method* call, and a closure inside an object expression, stay rejected even + // with the feature on (methods could escape their object scope; objexpr closures are emitted beside the + // object-expression class, not within it, so they cannot keep family access). + [] + [] + [] + let ``Protected method or object-expression closure stays rejected with the feature (issue 5302)`` (body: string) (diag: string) = + derivedMember body |> rejectedPreview diag + + // Regression for the object-expression soundness hole: an object expression deriving from BaseClass can + // read its own protected base field directly, but reading it from a surviving closure (here `lazy`) must + // stay rejected — that closure is emitted beside the object-expression class, so keeping the family region + // would type-check then throw FieldAccessException at runtime. + [] + let ``Protected base field from a closure inside an object expression stays rejected (issue 5302)`` () = + """ +module Test +open TestBaseClass +let make () = + { new BaseClass() with + override this.ToString() = (lazy this.ProtectedField).Value } +""" + |> rejectedPreview "field 'ProtectedField' is not accessible" + + // Without the language feature the access stays rejected (FS1097), proving the gate. + [] + let ``Protected base field from a closure is rejected without the language feature (issue 5302)`` () = + derivedMember "member x.Run() = let f () = x.ProtectedField in f ()" + |> rejectedAt withLangVersion80 "field 'ProtectedField' is not accessible" + // #19963, static-field (I_ldsfld) variant of the above. [] let ``Protected static base field read via optimized member does not crash (issue 19963)`` () =