diff --git a/docs/release-notes/.FSharp.Compiler.Service/11.0.0.md b/docs/release-notes/.FSharp.Compiler.Service/11.0.0.md index 5f2d1149fed..63ec01c0985 100644 --- a/docs/release-notes/.FSharp.Compiler.Service/11.0.0.md +++ b/docs/release-notes/.FSharp.Compiler.Service/11.0.0.md @@ -14,6 +14,7 @@ * Type relations cache: handle unsolved type variables ([Issue #19037](https://github.com/dotnet/fsharp/issues/19037)) ([PR #19040](https://github.com/dotnet/fsharp/pull/19040)) * Fix insertion context for modules with multiline attributes. ([Issue #18671](https://github.com/dotnet/fsharp/issues/18671)) * Fix `--typecheck-only` for scripts stopping after processing `#load`-ed script ([PR #19048](https://github.com/dotnet/fsharp/pull/19048)) +* Fix object expressions in struct types generating invalid IL with byref fields causing TypeLoadException at runtime. ([Issue #19068](https://github.com/dotnet/fsharp/issues/19068), [PR #19070](https://github.com/dotnet/fsharp/pull/19070)) ### Added diff --git a/src/Compiler/Checking/Expressions/CheckExpressions.fs b/src/Compiler/Checking/Expressions/CheckExpressions.fs index ae8c9b386d8..e37d244c68b 100644 --- a/src/Compiler/Checking/Expressions/CheckExpressions.fs +++ b/src/Compiler/Checking/Expressions/CheckExpressions.fs @@ -7236,6 +7236,13 @@ and TcObjectExpr (cenv: cenv) env tpenv (objTy, realObjTy, argopt, binds, extraI // Add the object type to the ungeneralizable items let env = {env with eUngeneralizableItems = addFreeItemOfTy objTy env.eUngeneralizableItems } + // Save the enclosing struct context BEFORE EnterFamilyRegion overwrites env.eFamilyType. + // This is used later to detect struct instance captures that would generate illegal byref fields. + let enclosingStructTyconRefOpt = + match env.eFamilyType with + | Some tcref when tcref.IsStructOrEnumTycon -> Some tcref + | _ -> None + // Object expression members can access protected members of the implemented type let env = EnterFamilyRegion tcref env let ad = env.AccessRights @@ -7344,8 +7351,20 @@ and TcObjectExpr (cenv: cenv) env tpenv (objTy, realObjTy, argopt, binds, extraI errorR (Error(FSComp.SR.tcInvalidObjectExpressionSyntaxForm (), mWholeExpr)) // 4. Build the implementation - let expr = mkObjExpr(objtyR, baseValOpt, ctorCall, overrides', extraImpls, mWholeExpr) - let expr = mkCoerceIfNeeded g realObjTy objtyR expr + // Check for struct instance captures that would generate illegal byref fields. + // See AnalyzeObjExprStructCaptures and TransformObjExprForStructByrefCaptures for details. + let shouldTransform, structCaptures, _ = + AnalyzeObjExprStructCaptures enclosingStructTyconRefOpt ctorCall overrides' extraImpls + + let expr = + if not shouldTransform then + // No transformation needed - build the object expression directly + let expr = mkObjExpr(objtyR, baseValOpt, ctorCall, overrides', extraImpls, mWholeExpr) + mkCoerceIfNeeded g realObjTy objtyR expr + else + // Transform to avoid byref captures + TransformObjExprForStructByrefCaptures g mWholeExpr structCaptures objtyR baseValOpt ctorCall overrides' extraImpls realObjTy + expr, tpenv //------------------------------------------------------------------------- diff --git a/src/Compiler/Checking/Expressions/CheckExpressionsOps.fs b/src/Compiler/Checking/Expressions/CheckExpressionsOps.fs index e540fa4b116..0fe8e296b81 100644 --- a/src/Compiler/Checking/Expressions/CheckExpressionsOps.fs +++ b/src/Compiler/Checking/Expressions/CheckExpressionsOps.fs @@ -2,6 +2,7 @@ module internal FSharp.Compiler.CheckExpressionsOps +open Internal.Utilities.Collections open Internal.Utilities.Library open Internal.Utilities.Library.Extras open FSharp.Compiler.CheckBasics @@ -389,3 +390,128 @@ let inline mkOptionalParamTyBasedOnAttribute (g: TcGlobals.TcGlobals) tyarg attr mkValueOptionTy g tyarg else mkOptionTy g tyarg + +//------------------------------------------------------------------------- +// Struct byref capture fix for object expressions +//------------------------------------------------------------------------- + +/// When a struct instance method creates an object expression that captures constructor +/// parameters, those captures go through 'this' which is a byref. This would create +/// illegal byref fields in the closure class. This function detects such captures and +/// extracts them to local bindings before the object expression. +/// +/// Returns: (shouldTransform, structCaptures, methodParamStamps) +let AnalyzeObjExprStructCaptures + (enclosingStructTyconRefOpt: TyconRef option) + (ctorCall: Expr) + (overrides: ObjExprMethod list) + (extraImpls: (TType * ObjExprMethod list) list) + : bool * Val list * Set = + + // Collect free variables from an expression + let collectFreeVars expr = + (freeInExpr CollectLocals expr).FreeLocals |> Zset.elements + + // Collect all method parameters (bound variables) from object expression methods + // These should NOT be treated as struct instance captures + let methodParams = + [ + for TObjExprMethod(_, _, _, paramGroups, _, _) in overrides do + for paramGroup in paramGroups do + for v in paramGroup do + yield v + for (_, methods) in extraImpls do + for TObjExprMethod(_, _, _, paramGroups, _, _) in methods do + for paramGroup in paramGroups do + for v in paramGroup do + yield v + ] + |> List.map (fun v -> v.Stamp) + |> Set.ofList + + let allFreeVars = + [ + yield! collectFreeVars ctorCall + for TObjExprMethod(_, _, _, _, body, _) in overrides do + yield! collectFreeVars body + for (_, methods) in extraImpls do + for TObjExprMethod(_, _, _, _, body, _) in methods do + yield! collectFreeVars body + ] + |> List.distinctBy (fun v -> v.Stamp) + + // Filter to struct instance captures: + // - We're in a struct context (enclosingStructTyconRefOpt is Some) + // - The value is NOT a method parameter of the object expression + // - The value is NOT a module binding + // - The value is NOT a member or module binding (excludes property getters, etc.) + // - The value is NOT a constructor + let structCaptures = + match enclosingStructTyconRefOpt with + | None -> [] + | Some _ -> + allFreeVars + |> List.filter (fun v -> + not v.IsModuleBinding + && not v.IsMemberOrModuleBinding + && not (Set.contains v.Stamp methodParams) + && v.LogicalName <> ".ctor") + + let shouldTransform = not (List.isEmpty structCaptures) + (shouldTransform, structCaptures, methodParams) + +/// Transform an object expression to avoid byref captures from struct instance state. +/// Creates local bindings for captured values and remaps references in the object expression. +let TransformObjExprForStructByrefCaptures + (g: TcGlobals.TcGlobals) + (mWholeExpr: Text.range) + (structCaptures: Val list) + (objtyR: TType) + (baseValOpt: Val option) + (ctorCall: Expr) + (overrides: ObjExprMethod list) + (extraImpls: (TType * ObjExprMethod list) list) + (realObjTy: TType) + : Expr = + + // Create local bindings for each captured value to avoid byref captures + let localBindings = + structCaptures + |> List.map (fun v -> + let local, _localExpr = + mkCompGenLocal mWholeExpr (v.LogicalName + "$captured") v.Type + + let readExpr = exprForVal mWholeExpr v + (v, local, readExpr)) + + // Build remap: original val -> local val + let remap = + localBindings + |> List.fold + (fun (r: Remap) (orig, local, _) -> + { r with + valRemap = r.valRemap.Add orig (mkLocalValRef local) + }) + Remap.Empty + + // Helper to remap an object expression method + let remapMethod (TObjExprMethod(slotSig, attrs, mtps, paramGroups, body, range)) = + TObjExprMethod(slotSig, attrs, mtps, paramGroups, remapExpr g CloneAll remap body, range) + + // Remap all parts of the object expression + let ctorCall' = remapExpr g CloneAll remap ctorCall + let overrides' = overrides |> List.map remapMethod + + let extraImpls' = + extraImpls |> List.map (fun (ty, ms) -> (ty, ms |> List.map remapMethod)) + + // Build the object expression with remapped references + let objExpr = + mkObjExpr (objtyR, baseValOpt, ctorCall', overrides', extraImpls', mWholeExpr) + + let objExpr = mkCoerceIfNeeded g realObjTy objtyR objExpr + + // Wrap with let bindings: let x$captured = x in ... + localBindings + |> List.foldBack (fun (_, local, valueExpr) body -> mkLet DebugPointAtBinding.NoneAtInvisible mWholeExpr local valueExpr body) + <| objExpr diff --git a/tests/FSharp.Compiler.ComponentTests/Conformance/Expressions/ObjectExpressions/StructObjectExpression.fs b/tests/FSharp.Compiler.ComponentTests/Conformance/Expressions/ObjectExpressions/StructObjectExpression.fs new file mode 100644 index 00000000000..28b530c9d29 --- /dev/null +++ b/tests/FSharp.Compiler.ComponentTests/Conformance/Expressions/ObjectExpressions/StructObjectExpression.fs @@ -0,0 +1,149 @@ +namespace FSharp.Compiler.ComponentTests.Conformance.Expressions + +open Xunit +open FSharp.Test.Compiler + +module StructObjectExpression = + + [] + let ``Object expression in struct should not generate byref field - simple case`` () = + Fsx """ +type Class(test : obj) = class end + +[] +type Struct(test : obj) = + member _.Test() = { + new Class(test) with + member _.ToString() = "" + } + +let s = Struct(42) +let obj = s.Test() + """ + |> withOptions [ "--nowarn:52" ] // Suppress struct copy warning + |> compileExeAndRun + |> shouldSucceed + + [] + let ``Object expression in struct with multiple fields`` () = + Fsx """ +type Base(x: int, y: string) = class end + +[] +type MyStruct(x: int, y: string) = + member _.CreateObj() = { + new Base(x, y) with + member _.ToString() = y + string x + } + +let s = MyStruct(42, "test") +let obj = s.CreateObj() + """ + |> withOptions [ "--nowarn:52" ] + |> compileExeAndRun + |> shouldSucceed + + [] + let ``Object expression in struct referencing field in override method`` () = + Fsx """ +type IFoo = + abstract member DoSomething : unit -> int + +[] +type MyStruct(value: int) = + member _.CreateFoo() = { + new IFoo with + member _.DoSomething() = value * 2 + } + +let s = MyStruct(21) +let foo = s.CreateFoo() +let result = foo.DoSomething() + """ + |> withOptions [ "--nowarn:52" ] + |> compileExeAndRun + |> shouldSucceed + + // Regression tests - these must continue to work + + [] + let ``Static member in struct with object expression should compile - StructBox regression`` () = + // This is the StructBox.Comparer pattern from FSharp.Core/seqcore.fs + // Static members don't have 'this' so should NOT be transformed + Fsx """ +open System.Collections.Generic + +[] +type StructBox<'T when 'T: equality>(value: 'T) = + member x.Value = value + + static member Comparer = + let gcomparer = HashIdentity.Structural<'T> + { new IEqualityComparer> with + member _.GetHashCode(v) = gcomparer.GetHashCode(v.Value) + member _.Equals(v1, v2) = gcomparer.Equals(v1.Value, v2.Value) } + +let comparer = StructBox.Comparer +let box1 = StructBox(42) +let box2 = StructBox(42) +let result = comparer.Equals(box1, box2) +if not result then failwith "Expected equal" + """ + |> compileExeAndRun + |> shouldSucceed + + [] + let ``Module level object expression with struct parameter should compile`` () = + // Module-level functions don't have instance context + Fsx """ +[] +type MyStruct(value: int) = + member x.Value = value + +let createComparer () = + { new System.Object() with + member _.ToString() = "comparer" } + +let c = createComparer() +if c.ToString() <> "comparer" then failwith "Failed" + """ + |> compileExeAndRun + |> shouldSucceed + + [] + let ``Object expression in struct not capturing anything should compile`` () = + // Object expression that doesn't reference any struct state + Fsx """ +[] +type MyStruct(value: int) = + member _.CreateObj() = { + new System.Object() with + member _.ToString() = "constant" + } + +let s = MyStruct(42) +let obj = s.CreateObj() +if obj.ToString() <> "constant" then failwith "Failed" + """ + |> withOptions [ "--nowarn:52" ] + |> compileExeAndRun + |> shouldSucceed + + [] + let ``Object expression in struct with method parameters should not confuse params with captures`` () = + // Method parameters are not instance captures, should not trigger transformation + Fsx """ +[] +type MyStruct(value: int) = + member _.Transform(multiplier: int) = { + new System.Object() with + member _.ToString() = string (value * multiplier) + } + +let s = MyStruct(21) +let obj = s.Transform(2) +if obj.ToString() <> "42" then failwith "Expected 42" + """ + |> withOptions [ "--nowarn:52" ] + |> compileExeAndRun + |> shouldSucceed diff --git a/tests/FSharp.Compiler.ComponentTests/FSharp.Compiler.ComponentTests.fsproj b/tests/FSharp.Compiler.ComponentTests/FSharp.Compiler.ComponentTests.fsproj index 23eb9501735..dad4da05fad 100644 --- a/tests/FSharp.Compiler.ComponentTests/FSharp.Compiler.ComponentTests.fsproj +++ b/tests/FSharp.Compiler.ComponentTests/FSharp.Compiler.ComponentTests.fsproj @@ -87,6 +87,7 @@ +