WIP :: Bugfix :: Fix F# exception serialization to preserve fields

docs/release-notes/.FSharp.Compiler.Service/10.0.300.md

@@ -32,4 +32,6 @@
 * Symbols: safer qualified name getting ([PR #19298](https://github.com/dotnet/fsharp/pull/19298))
 
 
+* Fix F# exception serialization now preserves fields. (Issue [#878](https://github.com/dotnet/fsharp/issues/878), [PR #19342](https://github.com/dotnet/fsharp/pull/19342))
+
 ### Breaking Changes

src/Compiler/CodeGen/IlxGen.fs

@@ -11908,13 +11908,60 @@ and GenExnDef cenv mgbuf eenv m (exnc: Tycon) : ILTypeRef option =
             match g.iltyp_SerializationInfo, g.iltyp_StreamingContext with
             | Some serializationInfoType, Some streamingContextType ->
 
+                let emitSerializationFieldIL emitPerField =
+                    [
+                        for (ilPropName, ilFieldName, ilPropType, _) in fieldNamesAndTypes do
+                            yield! emitPerField ilPropName ilFieldName ilPropType
+                    ]
+
+                let isILValueType (ty: ILType) =
+                    ty.IsNominal && ty.Boxity = ILBoxity.AsValue
+
+                let ilInstrsToRestoreFields =
+                    emitSerializationFieldIL (fun ilPropName ilFieldName ilPropType ->
+                        [
+                            mkLdarg0
+                            mkLdarg 1us
+                            I_ldstr ilPropName
+                            I_ldtoken(ILToken.ILType ilPropType)
+
+                            mkNormalCall (
+                                mkILNonGenericStaticMethSpecInTy (
+                                    g.ilg.typ_Type,
+                                    "GetTypeFromHandle",
+                                    [ g.iltyp_RuntimeTypeHandle ],
+                                    g.ilg.typ_Type
+                                )
+                            )
+
+                            mkNormalCallvirt (
+                                mkILNonGenericInstanceMethSpecInTy (
+                                    serializationInfoType,
+                                    "GetValue",
+                                    [ g.ilg.typ_String; g.ilg.typ_Type ],
+                                    g.ilg.typ_Object
+                                )
+                            )
+
+                            if isILValueType ilPropType then
+                                I_unbox_any ilPropType
+                            else
+                                I_castclass ilPropType
+
+                            mkNormalStfld (mkILFieldSpecInTy (ilThisTy, ilFieldName, ilPropType))
+                        ])
+
                 let ilInstrsForSerialization =
                     [
                         mkLdarg0
                         mkLdarg 1us
                         mkLdarg 2us
                         mkNormalCall (mkILCtorMethSpecForTy (g.iltyp_Exception, [ serializationInfoType; streamingContextType ]))
                     ]
+                    @ (if fieldNamesAndTypes.IsEmpty then
+                           []
+                       else
+                           ilInstrsToRestoreFields)
                     |> nonBranchingInstrsToCode
 
                 let ilCtorDefForSerialization =
@@ -11927,7 +11974,60 @@ and GenExnDef cenv mgbuf eenv m (exnc: Tycon) : ILTypeRef option =
                         mkMethodBody (false, [], 8, ilInstrsForSerialization, None, eenv.imports)
                     )
 
-                [ ilCtorDefForSerialization ]
+                let ilInstrsToSaveFields =
+                    emitSerializationFieldIL (fun ilPropName ilFieldName ilPropType ->
+                        [
+                            mkLdarg 1us
+                            I_ldstr ilPropName
+                            mkLdarg0
+                            mkNormalLdfld (mkILFieldSpecInTy (ilThisTy, ilFieldName, ilPropType))
+
+                            if isILValueType ilPropType then
+                                I_box ilPropType
+
+                            mkNormalCallvirt (
+                                mkILNonGenericInstanceMethSpecInTy (
+                                    serializationInfoType,
+                                    "AddValue",
+                                    [ g.ilg.typ_String; g.ilg.typ_Object ],
+                                    ILType.Void
+                                )
+                            )
+                        ])
+
+                let ilInstrsForGetObjectData =
+                    [
+                        mkLdarg0
+                        mkLdarg 1us
+                        mkLdarg 2us
+                        mkNormalCall (
+                            mkILNonGenericInstanceMethSpecInTy (
+                                g.iltyp_Exception,
+                                "GetObjectData",
+                                [ serializationInfoType; streamingContextType ],
+                                ILType.Void
+                            )
+                        )
+                    ]
+                    @ ilInstrsToSaveFields
+                    |> nonBranchingInstrsToCode
+
+                let ilGetObjectDataDef =
+                    mkILNonGenericVirtualInstanceMethod (
+                        "GetObjectData",
+                        ILMemberAccess.Public,
+                        [
+                            mkILParamNamed ("info", serializationInfoType)
+                            mkILParamNamed ("context", streamingContextType)
+                        ],
+                        mkILReturn ILType.Void,
+                        mkMethodBody (false, [], 8, ilInstrsForGetObjectData, None, eenv.imports)
+                    )
+
+                if fieldNamesAndTypes.IsEmpty then
+                    [ ilCtorDefForSerialization ]
+                else
+                    [ ilCtorDefForSerialization; ilGetObjectDataDef ]
             | _ -> []
 
         let ilTypeName = tref.Name

tests/FSharp.Compiler.ComponentTests/EmittedIL/CodeGenRegressions/CodeGenRegressions_Exceptions.fs

@@ -0,0 +1,107 @@
+// Copyright (c) Microsoft Corporation.  All Rights Reserved.  See License.txt in the project root for license information.
+
+namespace EmittedIL
+
+open Xunit
+open FSharp.Test
+open FSharp.Test.Compiler
+open FSharp.Test.Utilities
+
+module CodeGenRegressions_Exceptions =
+
+    let private getActualIL (result: CompilationResult) =
+        match result with
+        | CompilationResult.Success s ->
+            match s.OutputPath with
+            | Some p ->
+                let (_, _, actualIL) = ILChecker.verifyILAndReturnActual [] p [ "// dummy" ]
+                actualIL
+            | None -> failwith "No output path"
+        | _ -> failwith "Compilation failed"
+
+    // https://github.com/dotnet/fsharp/issues/878
+    [<Fact>]
+    let ``Issue_878_ExceptionSerialization`` () =
+        let source = """
+module Test
+
+exception Foo of x:string * y:int
+"""
+        let result =
+            FSharp source
+            |> asLibrary
+            |> compile
+            |> shouldSucceed
+
+        result
+        |> verifyIL [
+            ".method public strict virtual instance void GetObjectData(class [runtime]System.Runtime.Serialization.SerializationInfo info, valuetype [runtime]System.Runtime.Serialization.StreamingContext context) cil managed"
+            "call       instance void [runtime]System.Exception::GetObjectData(class [runtime]System.Runtime.Serialization.SerializationInfo,"
+            ".method family specialname rtspecialname instance void  .ctor(class [runtime]System.Runtime.Serialization.SerializationInfo info, valuetype [runtime]System.Runtime.Serialization.StreamingContext context) cil managed"
+        ]
+        |> ignore
+
+        let actualIL = getActualIL result
+        Assert.Contains("AddValue", actualIL)
+
+    // https://github.com/dotnet/fsharp/issues/878
+
+    [<Fact>]
+    let ``Issue_878_ExceptionSerialization_Roundtrip`` () =
+        let source = """
+module Test
+open System
+open System.Runtime.Serialization
+
+#nowarn "44" // Serialization types are obsolete but needed for testing ISerializable
+#nowarn "67"
+
+exception Foo of x:string * y:int
+
+let roundtrip (e: Exception) =
+    let info = SerializationInfo(e.GetType(), FormatterConverter())
+    let ctx = StreamingContext(StreamingContextStates.All)
+    e.GetObjectData(info, ctx)
+    let ctor =
+        e.GetType().GetConstructor(
+            System.Reflection.BindingFlags.Instance ||| System.Reflection.BindingFlags.NonPublic ||| System.Reflection.BindingFlags.Public,
+            null,
+            [| typeof<SerializationInfo>; typeof<StreamingContext> |],
+            null)
+    if ctor = null then failwith "Deserialization constructor not found"
+    ctor.Invoke([| info :> obj; ctx :> obj |]) :?> Exception
+
+[<EntryPoint>]
+let main _ =
+    let original = Foo("value", 42)
+    // Check GetObjectData actually writes our fields
+    let info = SerializationInfo(original.GetType(), FormatterConverter())
+    let ctx = StreamingContext(StreamingContextStates.All)
+    original.GetObjectData(info, ctx)
+    let xVal = info.GetString("x")
+    let yVal = info.GetInt32("y")
+    if xVal <> "value" then failwithf "GetObjectData: Expected x='value', got '%s'" xVal
+    if yVal <> 42 then failwithf "GetObjectData: Expected y=42, got %d" yVal
+
+    // Check full roundtrip
+    let cloned = roundtrip original
+    // Access fields via internal backing fields using reflection
+    let xField = cloned.GetType().GetField("x@", System.Reflection.BindingFlags.Instance ||| System.Reflection.BindingFlags.NonPublic)
+    let yField = cloned.GetType().GetField("y@", System.Reflection.BindingFlags.Instance ||| System.Reflection.BindingFlags.NonPublic)
+    if xField = null then failwith "Field x@ not found"
+    if yField = null then failwith "Field y@ not found"
+    let xCloned = xField.GetValue(cloned) :?> string
+    let yCloned = yField.GetValue(cloned) :?> int
+    if xCloned <> "value" then failwithf "Roundtrip: Expected x='value', got '%s'" xCloned
+    if yCloned <> 42 then failwithf "Roundtrip: Expected y=42, got %d" yCloned
+    printfn "SUCCESS: Foo(value, 42) roundtripped correctly"
+    0
+"""
+        FSharp source
+        |> asExe
+        |> ignoreWarnings
+        |> compile
+        |> shouldSucceed
+        |> run
+        |> shouldSucceed
+        |> ignore