Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Bugfix : Struct DU with DefaultAugment(false) and a non-nullary field #16326

Merged
merged 3 commits into from
Nov 23, 2023
Merged

Bugfix : Struct DU with DefaultAugment(false) and a non-nullary field #16326

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
3 commits
Select commit Hold shift + click to select a range
6de6bc5
fix bug with defaultaugment(false)
T-Gro Nov 22, 2023
4dca2be
without newline
T-Gro Nov 22, 2023
1300abb
Making sure that nullary case works
T-Gro Nov 23, 2023
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
96 changes: 51 additions & 45 deletions src/Compiler/CodeGen/EraseUnions.fs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -751,6 +751,53 @@ let convAlternativeDef
// within FSharp.Core.dll on fresh unpublished cons cells.
let isTotallyImmutable = (cud.HasHelpers <> SpecialFSharpListHelpers)

let makeNonNullaryMakerMethod () =
let locals, ilInstrs =
if repr.RepresentAlternativeAsStructValue info then
let local = mkILLocal baseTy None
let ldloca = I_ldloca(0us)

let ilInstrs =
[
ldloca
ILInstr.I_initobj baseTy
if (repr.DiscriminationTechnique info) = IntegerTag && num <> 0 then
ldloca
mkLdcInt32 num
mkSetTagToField g.ilg cuspec baseTy
for i in 0 .. fields.Length - 1 do
ldloca
mkLdarg (uint16 i)
mkNormalStfld (mkILFieldSpecInTy (baseTy, fields[i].LowerName, fields[i].Type))
mkLdloc 0us
]

[ local ], ilInstrs
else
let ilInstrs =
[
for i in 0 .. fields.Length - 1 do
mkLdarg (uint16 i)
yield! convNewDataInstrInternal g.ilg cuspec num
]

[], ilInstrs

let mdef =
mkILNonGenericStaticMethod (
mkMakerName cuspec altName,
cud.HelpersAccessibility,
fields
|> Array.map (fun fd -> mkILParamNamed (fd.LowerName, fd.Type))
|> Array.toList,
mkILReturn baseTy,
mkMethodBody (true, locals, fields.Length + locals.Length, nonBranchingInstrsToCode ilInstrs, attr, imports)
)
|> addMethodGeneratedAttrs
|> addAltAttribs

mdef

let altUniqObjMeths =

// This method is only generated if helpers are not available. It fetches the unique object for the alternative
Expand Down Expand Up @@ -885,54 +932,13 @@ let convAlternativeDef
[ nullaryMeth ], [ nullaryProp ]

else
let locals, ilInstrs =
if repr.RepresentAlternativeAsStructValue info then
let local = mkILLocal baseTy None
let ldloca = I_ldloca(0us)

let ilInstrs =
[
ldloca
ILInstr.I_initobj baseTy
if (repr.DiscriminationTechnique info) = IntegerTag && num <> 0 then
ldloca
mkLdcInt32 num
mkSetTagToField g.ilg cuspec baseTy
for i in 0 .. fields.Length - 1 do
ldloca
mkLdarg (uint16 i)
mkNormalStfld (mkILFieldSpecInTy (baseTy, fields[i].LowerName, fields[i].Type))
mkLdloc 0us
]

[ local ], ilInstrs
else
let ilInstrs =
[
for i in 0 .. fields.Length - 1 do
mkLdarg (uint16 i)
yield! convNewDataInstrInternal g.ilg cuspec num
]

[], ilInstrs

let mdef =
mkILNonGenericStaticMethod (
mkMakerName cuspec altName,
cud.HelpersAccessibility,
fields
|> Array.map (fun fd -> mkILParamNamed (fd.LowerName, fd.Type))
|> Array.toList,
mkILReturn baseTy,
mkMethodBody (true, locals, fields.Length + locals.Length, nonBranchingInstrsToCode ilInstrs, attr, imports)
)
|> addMethodGeneratedAttrs
|> addAltAttribs

[ mdef ], []
[ makeNonNullaryMakerMethod () ], []

(baseMakerMeths @ baseTesterMeths), (baseMakerProps @ baseTesterProps)

| NoHelpers when not (alt.IsNullary) && cuspecRepr.RepresentAlternativeAsStructValue(cuspec) ->
// For non-nullary struct DUs, maker method is used to create their values.
[ makeNonNullaryMakerMethod () ], []
| NoHelpers -> [], []

let typeDefs, altDebugTypeDefs, altNullaryFields =
Expand Down
19 changes: 19 additions & 0 deletions tests/FSharp.Compiler.ComponentTests/Conformance/Types/UnionTypes/UnionStructTypes.fs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -701,6 +701,25 @@ type GenericStructDu<'T> = EmptyFirst | SingleVal of f:'T | DoubleVal of f2:'T *
|> compile
|> shouldSucceed

[<Fact>]
let ``Regression 16282 DefaultAugment false on a struct union with fields`` () =
Fsx """
[<Struct>]
[<DefaultAugmentation(false)>]
type Foo =
| Baz of int
| Bat
| Batman


let foo = [Baz 42; Bat; Batman]
printf "%A" foo"""
|> asExe
|> compile
|> shouldSucceed
|> run
|> verifyOutput "[Baz 42; Bat; Batman]"

[<Fact>]
let ``Struct DU ValueOption keeps working`` () =
Fsx """
Expand Down