From 3299cec0a4f5be1d69d899265c60483bba84647d Mon Sep 17 00:00:00 2001 From: KevinRansom Date: Tue, 6 Feb 2024 22:48:21 -0800 Subject: [PATCH 1/2] Fix16431 - Modify DU static initialization #16661 --- .../.FSharp.Compiler.Service/8.0.300.md | 2 +- src/Compiler/AbstractIL/il.fs | 26 ++++++ src/Compiler/AbstractIL/il.fsi | 3 +- src/Compiler/CodeGen/IlxGen.fs | 80 +++++++++++-------- .../Types/UnionTypes/UnionTypes.fs | 40 ++++++++++ 5 files changed, 114 insertions(+), 37 deletions(-) diff --git a/docs/release-notes/.FSharp.Compiler.Service/8.0.300.md b/docs/release-notes/.FSharp.Compiler.Service/8.0.300.md index b8dc1de0de9..254e52c3876 100644 --- a/docs/release-notes/.FSharp.Compiler.Service/8.0.300.md +++ b/docs/release-notes/.FSharp.Compiler.Service/8.0.300.md @@ -5,7 +5,7 @@ * Graph Based Checking doesn't throw on invalid parsed input so it can be used for IDE scenarios ([PR #16575](https://github.com/dotnet/fsharp/pull/16575), [PR #16588](https://github.com/dotnet/fsharp/pull/16588), [PR #16643](https://github.com/dotnet/fsharp/pull/16643)) * Keep parens for problematic exprs (`if`, `match`, etc.) in `$"{(…):N0}"`, `$"{(…),-3}"`, etc. ([PR #16578](https://github.com/dotnet/fsharp/pull/16578)) * Fix crash in DOTNET_SYSTEM_GLOBALIZATION_INVARIANT mode [#PR 16471](https://github.com/dotnet/fsharp/pull/16471)) - +* Alter initialization code for DUs.[#PR 16661](https://github.com/dotnet/fsharp/pull/16661) ### Added diff --git a/src/Compiler/AbstractIL/il.fs b/src/Compiler/AbstractIL/il.fs index aa6c4aae69e..7f303178553 100644 --- a/src/Compiler/AbstractIL/il.fs +++ b/src/Compiler/AbstractIL/il.fs @@ -3952,6 +3952,29 @@ let mdef_code2code f (md: ILMethodDef) = let b = MethodBody.IL(notlazy ilCode) md.With(body = notlazy b) +let appendInstrsToCode (instrs: ILInstr list) (c2: ILCode) = + let instrs = Array.ofList instrs + + match + c2.Instrs + |> Array.tryFindIndexBack (fun instr -> + match instr with + | I_ret -> true + | _ -> false) + with + | Some 0 -> + { c2 with + Instrs = Array.concat [| instrs; c2.Instrs |] + } + | Some index -> + { c2 with + Instrs = Array.concat [| c2.Instrs[.. index - 1]; instrs; c2.Instrs[index..] |] + } + | None -> + { c2 with + Instrs = Array.append c2.Instrs instrs + } + let prependInstrsToCode (instrs: ILInstr list) (c2: ILCode) = let instrs = Array.ofList instrs let n = instrs.Length @@ -3985,6 +4008,9 @@ let prependInstrsToCode (instrs: ILInstr list) (c2: ILCode) = Instrs = Array.append instrs c2.Instrs } +let appendInstrsToMethod newCode md = + mdef_code2code (appendInstrsToCode newCode) md + let prependInstrsToMethod newCode md = mdef_code2code (prependInstrsToCode newCode) md diff --git a/src/Compiler/AbstractIL/il.fsi b/src/Compiler/AbstractIL/il.fsi index 5ba803fb757..5e02f4c0c1e 100644 --- a/src/Compiler/AbstractIL/il.fsi +++ b/src/Compiler/AbstractIL/il.fsi @@ -2162,8 +2162,9 @@ val internal mkRawDataValueTypeDef: ILType -> string * size: int32 * pack: uint1 /// the code, and the first instruction will be the new entry /// of the method. The instructions should be non-branching. +val internal appendInstrsToCode: ILInstr list -> ILCode -> ILCode +val internal appendInstrsToMethod: ILInstr list -> ILMethodDef -> ILMethodDef val internal prependInstrsToCode: ILInstr list -> ILCode -> ILCode - val internal prependInstrsToMethod: ILInstr list -> ILMethodDef -> ILMethodDef /// Injecting initialization code into a class. diff --git a/src/Compiler/CodeGen/IlxGen.fs b/src/Compiler/CodeGen/IlxGen.fs index e301813edae..6a574fadc14 100644 --- a/src/Compiler/CodeGen/IlxGen.fs +++ b/src/Compiler/CodeGen/IlxGen.fs @@ -1908,7 +1908,16 @@ type TypeDefBuilder(tdef: ILTypeDef, tdefDiscards) = if not discard then AddPropertyDefToHash m gproperties pdef - member _.PrependInstructionsToSpecificMethodDef(cond, instrs, tag, imports) = + member _.AppendInstructionsToSpecificMethodDef(cond, instrs, tag, imports) = + match ResizeArray.tryFindIndex cond gmethods with + | Some idx -> gmethods[idx] <- appendInstrsToMethod instrs gmethods[idx] + | None -> + let body = + mkMethodBody (false, [], 1, nonBranchingInstrsToCode instrs, tag, imports) + + gmethods.Add(mkILClassCtor body) + + member this.PrependInstructionsToSpecificMethodDef(cond, instrs, tag, imports) = match ResizeArray.tryFindIndex cond gmethods with | Some idx -> gmethods[idx] <- prependInstrsToMethod instrs gmethods[idx] | None -> @@ -1917,6 +1926,8 @@ type TypeDefBuilder(tdef: ILTypeDef, tdefDiscards) = gmethods.Add(mkILClassCtor body) + this + and TypeDefsBuilder() = let tdefs = @@ -2264,6 +2275,22 @@ and AssemblyBuilder(cenv: cenv, anonTypeTable: AnonTypeGenerationTable) as mgbuf /// static init fields on script modules. let scriptInitFspecs = ConcurrentStack() + let initialInstrs seqpt feefee = + [ + yield! + (if isEnvVarSet "NO_ADD_FEEFEE_TO_CCTORS" then [] + elif isEnvVarSet "ADD_SEQPT_TO_CCTORS" then seqpt + else feefee) // mark start of hidden code + ] + + let finalInstrs fspec = + [ + yield mkLdcInt32 0 + yield mkNormalStsfld fspec + yield mkNormalLdsfld fspec + yield AI_pop + ] + member _.AddScriptInitFieldSpec(fieldSpec, range) = scriptInitFspecs.Push((fieldSpec, range)) @@ -2276,15 +2303,7 @@ and AssemblyBuilder(cenv: cenv, anonTypeTable: AnonTypeGenerationTable) as mgbuf let InitializeCompiledScript (fspec, m) = let ilDebugRange = GenPossibleILDebugRange cenv m - mgbuf.AddExplicitInitToSpecificMethodDef( - (fun (md: ILMethodDef) -> md.IsEntryPoint), - tref, - fspec, - ilDebugRange, - imports, - [], - [] - ) + mgbuf.AddExplicitInitToEntryPoint(tref, fspec, ilDebugRange, imports, [], []) scriptInitFspecs |> Seq.iter InitializeCompiledScript | None -> () @@ -2325,24 +2344,23 @@ and AssemblyBuilder(cenv: cenv, anonTypeTable: AnonTypeGenerationTable) as mgbuf if ilMethodDef.IsEntryPoint then explicitEntryPointInfo <- Some tref - member _.AddExplicitInitToSpecificMethodDef(cond, tref, fspec, sourceOpt, imports, feefee, seqpt) = - // Authoring a .cctor with effects forces the cctor for the 'initialization' module by doing a dummy store & load of a field - // Doing both a store and load keeps FxCop happier because it thinks the field is useful - let instrs = - [ - yield! - (if isEnvVarSet "NO_ADD_FEEFEE_TO_CCTORS" then [] - elif isEnvVarSet "ADD_SEQPT_TO_CCTORS" then seqpt - else feefee) // mark start of hidden code - yield mkLdcInt32 0 - yield mkNormalStsfld fspec - yield mkNormalLdsfld fspec - yield AI_pop - ] + member _.AddExplicitInitToEntryPoint(tref, fspec, sourceOpt, imports, feefee, seqpt) = + + let cond = (fun (md: ILMethodDef) -> md.IsEntryPoint) gtdefs .FindNestedTypeDefBuilder(tref) - .PrependInstructionsToSpecificMethodDef(cond, instrs, sourceOpt, imports) + .PrependInstructionsToSpecificMethodDef(cond, (initialInstrs seqpt feefee) @ (finalInstrs fspec), sourceOpt, imports) + |> ignore + + member _.AddExplicitInitToCctor(tref, fspec, sourceOpt, imports, feefee, seqpt) = + + let cond = (fun (md: ILMethodDef) -> md.Name = ".cctor") + + gtdefs + .FindNestedTypeDefBuilder(tref) + .PrependInstructionsToSpecificMethodDef(cond, initialInstrs seqpt feefee, sourceOpt, imports) + .AppendInstructionsToSpecificMethodDef(cond, finalInstrs fspec, sourceOpt, imports) member _.AddEventDef(tref, edef) = gtdefs.FindNestedTypeDefBuilder(tref).AddEventDef(edef) @@ -10194,15 +10212,7 @@ and GenImplFile cenv (mgbuf: AssemblyBuilder) mainInfoOpt eenv (implFile: Checke // This adds the explicit init of the .cctor to the explicit entry point main method let ilDebugRange = GenPossibleILDebugRange cenv m - mgbuf.AddExplicitInitToSpecificMethodDef( - (fun md -> md.IsEntryPoint), - tref, - fspec, - ilDebugRange, - eenv.imports, - feefee, - seqpt - )) + mgbuf.AddExplicitInitToEntryPoint(tref, fspec, ilDebugRange, eenv.imports, feefee, seqpt)) let cctorMethDef = mkILClassCtor (MethodBody.IL(InterruptibleLazy.FromValue topCode)) @@ -10289,7 +10299,7 @@ and GenForceWholeFileInitializationAsPartOfCCtor cenv (mgbuf: AssemblyBuilder) ( // Doing both a store and load keeps FxCop happier because it thinks the field is useful lazyInitInfo.Add(fun fspec feefee seqpt -> let ilDebugRange = GenPossibleILDebugRange cenv m - mgbuf.AddExplicitInitToSpecificMethodDef((fun md -> md.Name = ".cctor"), tref, fspec, ilDebugRange, imports, feefee, seqpt)) + mgbuf.AddExplicitInitToCctor(tref, fspec, ilDebugRange, imports, feefee, seqpt)) /// Generate an Equals method. and GenEqualsOverrideCallingIComparable cenv (tcref: TyconRef, ilThisTy, _ilThatTy) = diff --git a/tests/FSharp.Compiler.ComponentTests/Conformance/Types/UnionTypes/UnionTypes.fs b/tests/FSharp.Compiler.ComponentTests/Conformance/Types/UnionTypes/UnionTypes.fs index ea40ea51cb1..e30a31edacf 100644 --- a/tests/FSharp.Compiler.ComponentTests/Conformance/Types/UnionTypes/UnionTypes.fs +++ b/tests/FSharp.Compiler.ComponentTests/Conformance/Types/UnionTypes/UnionTypes.fs @@ -609,3 +609,43 @@ module UnionTypes = |> withDiagnostics [ (Warning 42, Line 11, Col 12, Line 11, Col 24, "This construct is deprecated: it is only for use in the F# library") ] + + + //SOURCE=W_UnionCaseProduction01.fsx SCFLAGS="-a --test:ErrorRanges" # W_UnionCaseProduction01.fsx + [] + let ``UnionCaseInitialization_repro16431`` () = + + let testFs = + SourceCodeFileKind.Create( + "testFs.fs", + $""" +module Test + +type ABC = + | A + | B + | C of int + + static let c75' = ABC.C 75 + static member c75 = c75' + + static let ab' = [ A; B ] + static member ab = ab' + """) + + let programFs = + SourceCodeFileKind.Create( + "programFs.fs", + $""" +open Test + +if (sprintf "%%A" ABC.c75) <> "C 75" then failwith (sprintf "Failed: printing 'ABC.c75': Expected output: 'C 75' Actual output: '%%A'" ABC.c75) +if (sprintf "%%A" ABC.ab) <> "[A; B]" then failwith (sprintf "Failed: printing 'ABC.ab: Expected: '[A; B]' Actual: '%%A'" ABC.ab) + """) + + (fsFromString testFs) + |> FS + |> withAdditionalSourceFiles [programFs] + |> asExe + |> compileAndRun + |> shouldSucceed From 2708b01928e61dddabe57d6b4998c5c81d95d64c Mon Sep 17 00:00:00 2001 From: "Kevin Ransom (msft)" Date: Tue, 6 Feb 2024 23:46:19 -0800 Subject: [PATCH 2/2] Update docs/release-notes/.FSharp.Compiler.Service/8.0.300.md Co-authored-by: Florian Verdonck --- docs/release-notes/.FSharp.Compiler.Service/8.0.300.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/docs/release-notes/.FSharp.Compiler.Service/8.0.300.md b/docs/release-notes/.FSharp.Compiler.Service/8.0.300.md index 254e52c3876..bc685f29411 100644 --- a/docs/release-notes/.FSharp.Compiler.Service/8.0.300.md +++ b/docs/release-notes/.FSharp.Compiler.Service/8.0.300.md @@ -5,7 +5,7 @@ * Graph Based Checking doesn't throw on invalid parsed input so it can be used for IDE scenarios ([PR #16575](https://github.com/dotnet/fsharp/pull/16575), [PR #16588](https://github.com/dotnet/fsharp/pull/16588), [PR #16643](https://github.com/dotnet/fsharp/pull/16643)) * Keep parens for problematic exprs (`if`, `match`, etc.) in `$"{(…):N0}"`, `$"{(…),-3}"`, etc. ([PR #16578](https://github.com/dotnet/fsharp/pull/16578)) * Fix crash in DOTNET_SYSTEM_GLOBALIZATION_INVARIANT mode [#PR 16471](https://github.com/dotnet/fsharp/pull/16471)) -* Alter initialization code for DUs.[#PR 16661](https://github.com/dotnet/fsharp/pull/16661) +* Alter initialization code for DUs. ([#PR 16661](https://github.com/dotnet/fsharp/pull/16661)) ### Added