fix(beam): entry point argv and exit code, bigint from float, option reflection

src/Fable.Build/Test/Beam.fs

@@ -15,6 +15,100 @@ let private testRunnerSrc = Path.Resolve("tests", "Beam", "erl_test_runner.erl")
 let private testProjectName =
     Path.GetFileNameWithoutExtension("Fable.Tests.Beam.fsproj").Replace('.', '_').Replace('-', '_').ToLowerInvariant()
 
+/// Collect the ebin directories rebar3 produced, for `-pa`.
+let private ebinArgs (projectBuildDir: string) =
+    let libDir = Path.Combine(projectBuildDir, "_build", "default", "lib")
+
+    if Directory.Exists(libDir) then
+        Directory.GetDirectories(libDir)
+        |> Array.map (fun d -> Path.Combine(d, "ebin"))
+        |> Array.filter Directory.Exists
+        |> Array.map (fun d -> $"-pa \"{d}\"")
+        |> String.concat " "
+    else
+        ""
+
+/// Run an Erlang expression, returning its stdout and exit code. `Command.Run` throws on a non-zero
+/// exit, and a non-zero exit is exactly what one of these programs is supposed to produce.
+let private runErl (workingDir: string) (paArgs: string) (expr: string) =
+    let mutable exitCode = 0
+
+    let struct (output, _) =
+        Command.ReadAsync(
+            "erl",
+            $"-noshell {paArgs} -eval \"{expr}\" -s init stop",
+            workingDirectory = workingDir,
+            handleExitCode =
+                fun code ->
+                    exitCode <- code
+                    true
+        )
+        |> Async.AwaitTask
+        |> Async.RunSynchronously
+
+    output, exitCode
+
+let private expect (what: string) (expected: 'a) (actual: 'a) =
+    if expected <> actual then
+        failwith $"Entry point test: %s{what}\n  expected: %A{expected}\n  actual:   %A{actual}"
+
+/// Compile a whole program and run it on the BEAM through the generated `main.erl` shim.
+///
+/// The test suite calls test functions directly and so never executes the shim — which is how the
+/// shim stayed broken while the suite was green. This checks the three things a program depends on:
+/// that it runs at all, that argv reaches F#, and that the entry point's return value becomes the
+/// process exit code.
+let private testEntryPointPrograms () =
+    let compile (name: string) =
+        let programSourceDir = Path.Resolve("tests", "Beam", name)
+        let programBuildDir = Path.Resolve("temp", "tests", "Beam" + name)
+        Directory.clean programBuildDir
+
+        Command.Fable(
+            CmdLine.empty
+            |> CmdLine.appendRaw programSourceDir
+            |> CmdLine.appendPrefix "--outDir" programBuildDir
+            |> CmdLine.appendPrefix "--lang" "beam"
+            |> CmdLine.appendPrefix "--exclude" "Fable.Core"
+            |> CmdLine.appendRaw "--noCache",
+            workingDirectory = programBuildDir
+        )
+
+        Command.Run("rebar3", "compile", workingDirectory = programBuildDir)
+        programBuildDir, ebinArgs programBuildDir
+
+    printfn "Running entry point program tests..."
+
+    let buildDir, paArgs = compile "Program"
+
+    // An [<EntryPoint>] lowers to main/1: the program must run, and see its argv.
+    let output, exitCode =
+        runErl buildDir paArgs "main:main([\\\"alpha\\\", \\\"beta\\\"])"
+
+    expect "argv length" true (output.Contains "argc=2")
+    expect "argv contents" true (output.Contains "argv=alpha,beta")
+    expect "exit code of a successful run" 0 exitCode
+
+    // ...and its return value must become the exit code, or a failing suite looks like a passing one.
+    let _, failExitCode = runErl buildDir paArgs "main:main([\\\"fail\\\"])"
+    expect "exit code of a failing run" 3 failExitCode
+
+    // main/0 forwards to main/1 with an empty argv.
+    let output0, exitCode0 = runErl buildDir paArgs "main:main()"
+    expect "argv of main/0" true (output0.Contains "argc=0")
+    expect "exit code of main/0" 0 exitCode0
+
+    // A program with no [<EntryPoint>] has only top-level effects, and the shim falls back to main/0.
+    let noEntryBuildDir, noEntryPaArgs = compile "ProgramNoEntry"
+
+    let noEntryOutput, noEntryExitCode =
+        runErl noEntryBuildDir noEntryPaArgs "main:main()"
+
+    expect "top-level effects ran" true (noEntryOutput.Contains "no-entry-point program ran")
+    expect "exit code without an entry point" 0 noEntryExitCode
+
+    printfn "Entry point program tests passed"
+
 let handle (args: string list) =
     let isWatch = args |> List.contains "--watch"
     let noDotnet = args |> List.contains "--no-dotnet"
@@ -96,3 +190,7 @@ let handle (args: string list) =
             $"-noshell {paArgs} -eval \"erl_test_runner:main([\\\"{projectEbinDir}\\\"])\" -s init stop",
             workingDirectory = buildDir
         )
+
+        // The suite above calls test functions directly and never runs a program end to end, so the
+        // generated entry point shim is only exercised here.
+        testEntryPointPrograms ()

src/Fable.Cli/Main.fs

@@ -1139,14 +1139,38 @@ let private generateBeamScaffold (cliArgs: CliArgs) (entryModule: string) =
         && not (Fable.Beam.Naming.isFableLibraryPath cliArgs.ProjectFile)
         && IO.File.Exists(IO.Path.Combine(srcDir, entryModule + ".erl"))
     then
+        // An F# `[<EntryPoint>]` is `string[] -> int`, so it lowers to `main/1`, takes the argv, and
+        // returns the process exit code. A project without one (top-level effects only) has no
+        // `main/1` to call, so fall back to `main/0` when that is what the entry module exports.
+        //
+        // The argv has to cross into Fable's representations on the way in: an F# array is a
+        // reference read with `erlang:get/1`, and an F# string is a UTF-8 binary — whereas a runner
+        // hands us a plain list of char lists. Passing that list straight through would reach
+        // `erlang:get(Argv)` inside the entry module, yield `undefined`, and fail with `badarg`.
+        //
+        // And the exit code has to cross back out: an `[<EntryPoint>]` returning non-zero must exit
+        // non-zero, or a failing test suite reports success. `halt/1` flushes stdout by default, so
+        // the program's output is not lost. A `main/0` entry has no exit code to propagate, and
+        // returns normally so the runner's `-s init stop` ends the VM as before.
         let mainShim =
             $"""{generatedMarker}
 -module(main).
 -export([main/0, main/1]).
 
-main() -> {entryModule}:main().
+main() -> main([]).
 
-main(_Args) -> {entryModule}:main().
+main(Args) ->
+    _ = code:ensure_loaded({entryModule}),
+    case erlang:function_exported({entryModule}, main, 1) of
+        true ->
+            Argv = fable_utils:new_ref([unicode:characters_to_binary(A) || A <- Args]),
+            exit_with({entryModule}:main(Argv));
+        false ->
+            {entryModule}:main()
+    end.
+
+exit_with(Code) when is_integer(Code) -> erlang:halt(Code);
+exit_with(_) -> ok.
 """
 
         writeIfChanged (IO.Path.Combine(srcDir, "main.erl")) mainShim

src/Fable.Transforms/Beam/Fable2Beam.Reflection.fs

@@ -182,8 +182,40 @@ let rec private transformTypeInfoRec
 
         makeTypeInfoMap $"%s{prefix}`%d{n}" resolved
     | Fable.Option(genArg, _) ->
+        // `option` is a real F# union, so reflection has to report None/Some as cases — otherwise
+        // FSharpType.IsUnion is false for it and GetUnionCases/MakeUnion fail, unlike every other
+        // target. Its Beam representation is erased (None = undefined, Some v = v), which the
+        // generic bare-atom / tagged-tuple union shape cannot express, so each case carries an
+        // `erased_option` marker telling fable_reflection to build and read the native shape.
         let resolved = resolveGenerics [ genArg ]
-        makeTypeInfoMap "Microsoft.FSharp.Core.FSharpOption`1" resolved
+
+        let optionCase (tag: int) (name: string) (fields: Beam.ErlExpr list) =
+            Beam.ErlExpr.Map
+                [
+                    atomLit "tag", intLit tag
+                    atomLit "name", strLit name
+                    atomLit "erl_tag", atomLit (Fable.Beam.Naming.sanitizeErlangName name)
+                    atomLit "fields", Beam.ErlExpr.List fields
+                    atomLit "erased_option", atomLit "true"
+                ]
+
+        // Emitted as a plain list, not a `makeThunk` one: a record/union needs the thunk because its
+        // own fields are inlined into its reflection function and would otherwise recurse, whereas
+        // option's only case field is the generic arg, which resolves to a *call* to that type's
+        // reflection function and so cannot recurse here. It also keeps the type info comparable —
+        // two thunks built at different sites are distinct Erlang funs and never compare equal, which
+        // would break `typeof<'a option> = typeof<'a option>`.
+        Beam.ErlExpr.Map
+            [
+                atomLit "fullname", strLit "Microsoft.FSharp.Core.FSharpOption`1"
+                atomLit "generics", Beam.ErlExpr.List resolved
+                atomLit "cases",
+                Beam.ErlExpr.List
+                    [
+                        optionCase 0 "None" []
+                        optionCase 1 "Some" [ makePropertyInfo "Value" (transformTypeInfo com r genMap genArg) ]
+                    ]
+            ]
     | Fable.Nullable(genArg, true) ->
         let resolved = resolveGenerics [ genArg ]
         makeTypeInfoMap "Microsoft.FSharp.Core.FSharpOption`1" resolved

src/Fable.Transforms/Beam/Replacements.fs

@@ -23,6 +23,15 @@ let private wrapToIntType (com: ICompiler) r (t: Type) (sourceType: Type) (expr:
         Helper.LibCall(com, "fable_int", Integers.wrapFunctionName info, t, [ expr ], ?loc = r)
     | _ -> expr
 
+/// Convert an expression *into* a BigInteger. Erlang integers are already arbitrary-precision, so
+/// this is the identity for an integral source. A float must be truncated toward zero, the way
+/// `BigInteger(double)` does: leaving it as a float would hand a non-integer to the integer
+/// arithmetic downstream and fail with `badarith`.
+let private toBigIntFrom r (t: Type) (expr: Expr) =
+    match expr.Type with
+    | Number((Float16 | Float32 | Float64), _) -> emitExpr r t [ expr ] "trunc($0)"
+    | _ -> expr
+
 let private isFunctionType (t: Type) =
     match t with
     | LambdaType _
@@ -5614,7 +5623,7 @@ let tryCall
     | "Microsoft.FSharp.Core.NumericLiterals.NumericLiteralI" ->
         // Erlang has native arbitrary-precision integers, so BigInt ops map directly
         match info.CompiledName, thisArg, args with
-        | ".ctor", None, [ arg ] -> Some arg // bigint(x) = x in Erlang
+        | ".ctor", None, [ arg ] -> toBigIntFrom r t arg |> Some // bigint(x) = x in Erlang, bar a float
         | "op_Addition", None, [ left; right ] -> makeBinOp r t left right BinaryPlus |> Some
         | "op_Subtraction", None, [ left; right ] -> makeBinOp r t left right BinaryMinus |> Some
         | "op_Multiply", None, [ left; right ] -> makeBinOp r t left right BinaryMultiply |> Some
@@ -5640,8 +5649,12 @@ let tryCall
         | ("get_IsOne" | "IsOne"), Some thisObj, _ -> emitExpr r t [ thisObj ] "($0 =:= 1)" |> Some
         // A bigint is unbounded, so converting out of it narrows and has to truncate.
         // `ToInt64Unchecked` is the one that keeps .NET's non-throwing wrap either way.
+        // `op_Explicit` is declared on BigInteger for *both* directions, so a conversion whose
+        // target is the bigint itself (e.g. `bigint someFloat`) has to truncate rather than narrow.
         | ("ToInt64" | "ToInt64Unchecked" | "ToInt32" | "ToInt16" | "ToByte" | "ToSByte" | "op_Explicit"), None, [ arg ] ->
-            arg |> wrapToIntType com r t arg.Type |> Some
+            match t with
+            | Number(BigInt, _) -> toBigIntFrom r t arg |> Some
+            | _ -> arg |> wrapToIntType com r t arg.Type |> Some
         | "Parse", None, [ str ] -> emitExpr r t [ str ] "binary_to_integer($0)" |> Some
         | "Pow", None, [ base_; exp_ ] -> emitExpr r t [ base_; exp_ ] "math:pow($0, $1)" |> Some
         | "Log", None, [ arg ] -> emitExpr r t [ arg ] "math:log(float($0))" |> Some

src/fable-library-beam/fable_reflection.erl

@@ -224,6 +224,20 @@ get_union_case_fields(CaseInfo) ->
 %% tuple, so the compiler cannot wrap it at the call site the way it does for GetRecordFields.
 get_union_fields_value(Value, TypeInfo) ->
     Cases = force(maps:get(cases, TypeInfo)),
+    case Cases of
+        %% An erased option carries no tag of its own: `undefined` is None, anything else is Some.
+        [#{erased_option := true} | _] ->
+            case Value of
+                undefined ->
+                    {find_case_by_tag_num(0, Cases), fable_utils:new_ref([])};
+                _ ->
+                    {find_case_by_tag_num(1, Cases), fable_utils:new_ref([fable_option:value(Value)])}
+            end;
+        _ ->
+            get_union_fields_general(Value, Cases)
+    end.
+
+get_union_fields_general(Value, Cases) ->
     %% Determine the atom tag from the value
     Tag =
         if
@@ -250,20 +264,38 @@ get_union_fields_value(Value, TypeInfo) ->
     {CaseInfo, fable_utils:new_ref(Fields)}.
 
 %% FSharpValue.MakeUnion(caseInfo, values) — create union value from case info.
+%% `option` is erased on Beam (None = undefined, Some V = V), so its cases cannot be built as the
+%% generic bare-atom / tagged-tuple shape — fable_option:some/1 does the wrapping the value needs.
+make_union_value(#{erased_option := true, tag := 0}, _Values) ->
+    undefined;
+make_union_value(#{erased_option := true, tag := 1}, Values) ->
+    case to_value_list(Values) of
+        [V] -> fable_option:some(V);
+        Other -> erlang:error({bad_option_fields, Other})
+    end;
 make_union_value(CaseInfo, Values) ->
     Tag = maps:get(erl_tag, CaseInfo),
-    ValList =
-        case is_reference(Values) of
-            true -> erlang:get(Values);
-            false when is_list(Values) -> Values;
-            false -> Values
-        end,
+    ValList = to_value_list(Values),
     case ValList of
         % bare atom for fieldless cases
         [] -> Tag;
         _ -> erlang:list_to_tuple([Tag | ValList])
     end.
 
+%% The compiler types a union/record's field values as `obj[]`, which reaches here either as an
+%% array ref or as a plain list depending on the call site.
+to_value_list(Values) ->
+    case is_reference(Values) of
+        true -> erlang:get(Values);
+        false -> Values
+    end.
+
+find_case_by_tag_num(Tag, Cases) ->
+    case lists:search(fun(C) -> maps:get(tag, C) =:= Tag end, Cases) of
+        {value, Case} -> Case;
+        false -> erlang:error({union_case_not_found, Tag})
+    end.
+
 %% PropertyInfo.GetValue(propInfo, obj)
 get_value(PropInfo, Obj) ->
     maps:get(maps:get(erl_name, PropInfo), Obj).

tests/Beam/ArithmeticTests.fs

@@ -201,6 +201,66 @@ let ``test Big integers addition works`` () =
     let z = 1I
     (x + y + z) |> equal 59823749821707124891298739821798327321028091380982I
 
+// Erlang integers are already arbitrary-precision, so a bigint conversion is mostly the identity —
+// but a float has to be truncated toward zero the way BigInteger(double) does. Left as a float it
+// reaches the integer arithmetic below and fails with `badarith`.
+[<Fact>]
+let ``test BigInt from float truncates toward zero`` () =
+    let positive = 2.7
+    let negative = -2.7
+    let fraction = 0.9
+    // Toward zero, not floor: -2, not -3.
+    bigint positive |> equal 2I
+    bigint negative |> equal -2I
+    bigint fraction |> equal 0I
+
+// `3.0 == 3` is true in Erlang, so asserting the value alone cannot see a float left where an
+// integer belongs. `div`/`rem` accept integers only, so they do see it.
+[<Fact>]
+let ``test BigInt from float is an integer, not just equal to one`` () =
+    let x = 3.0
+    let b = bigint x
+    b % 2I |> equal 1I
+    b / 2I |> equal 1I
+    bigint.DivRem(b, 2I) |> equal (1I, 1I)
+
+[<Fact>]
+let ``test BigInt converted from a float can be used in arithmetic`` () =
+    let x = 2.5
+    let b = bigint x
+    b + 1I |> equal 3I
+    b * 2I |> equal 4I
+
+[<Fact>]
+let ``test BigInt from float32 truncates toward zero`` () =
+    let positive = 2.7f
+    let negative = -2.7f
+    bigint positive |> equal 2I
+    bigint negative |> equal -2I
+
+[<Fact>]
+let ``test BigInt round-trips through float`` () =
+    let b = 42I
+    let f = float b
+    bigint f |> equal 42I
+    bigint (round 2.7) |> equal 3I
+
+// The shape that broke Hedgehog's Range.exponential: bigint arithmetic, out to float, `**`, round,
+// and back into bigint — the result feeding integer arithmetic again.
+[<Fact>]
+let ``test BigInt exponential scaling round-trip works`` () =
+    let scale (origin: bigint) (bound: bigint) (sz: float) =
+        let diff =
+            ((float (abs (bound - origin) + 1I)) ** (sz / 99.0) - 1.0)
+            * float (sign (bound - origin))
+
+        bigint (round (float origin + diff))
+
+    scale 0I 100I 99.0 |> equal 100I
+    scale 0I 100I 0.0 |> equal 0I
+    // The result must still be an integer: `rem` would fail on a float.
+    (scale 0I 100I 99.0) % 7I |> equal 2I
+
 [<Fact>]
 let ``test BigInt Infix add can be generated`` () =
     4I + 2I |> equal 6I
@@ -1148,3 +1208,27 @@ let private fnv1a (s: string) =
 let ``test FNV-1a hashing matches .NET`` () =
     fnv1a "Fable" |> equal 959428905u
     fnv1a "hello world" |> equal 3582672807u
+
+// splitmix64 is what Hedgehog's PRNG is built on. Every step depends on uint64 multiplication
+// wrapping at 64 bits, so a single non-wrapping operation shows up as a completely different
+// stream — which makes it a far sharper detector of fixed-width bugs than any single arithmetic
+// assertion. The expected values are .NET's.
+let private splitmix64 (seed: uint64) =
+    let mutable state = seed
+
+    fun () ->
+        state <- state + 0x9E3779B97F4A7C15UL
+        let mutable z = state
+        z <- (z ^^^ (z >>> 30)) * 0xBF58476D1CE4E5B9UL
+        z <- (z ^^^ (z >>> 27)) * 0x94D049BB133111EBUL
+        z ^^^ (z >>> 31)
+
+[<Fact>]
+let ``test splitmix64 stream is bit-exact with .NET`` () =
+    let next = splitmix64 0UL
+    next () |> equal 16294208416658607535UL
+    next () |> equal 7960286522194355700UL
+    next () |> equal 487617019471545679UL
+
+    let next42 = splitmix64 42UL
+    next42 () |> equal 13679457532755275413UL