From 49ea6733a0c9932c6c544e8269ab3558882b69a8 Mon Sep 17 00:00:00 2001 From: Dag Brattli Date: Mon, 13 Jul 2026 15:36:13 +0200 Subject: [PATCH 1/3] fix(beam): truncate the float when converting into BigInteger MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Erlang integers are already arbitrary-precision, so `bigint x` was emitted as `x` — right for an integral x, wrong for a float, which must truncate toward zero the way BigInteger(double) does. The float was left where an integer was required and then flowed into integer arithmetic, surfacing downstream as a bare `badarith` — or, for narrower ranges, as silently wrong data rather than an error. It broke Hedgehog's Range.exponential, whose scaleExponential round-trips through bigint and float, and so every auto-derived value containing an int. `op_Explicit` is declared on BigInteger in both directions, so a conversion whose *target* is the bigint has to truncate rather than narrow. The existing bigint tests only convert out of bigint, and only assert values — and `3.0 == 3` is true in Erlang, so a value-only assertion cannot see a float left where an integer belongs. The new tests assert integrality too (div/rem reject a float), and cover float32, round-trips, and the scaleExponential shape. Also adds splitmix64 as a bit-exactness test: a PRNG built on uint64 wraparound is the sharpest detector there is of fixed-width integer bugs. Co-Authored-By: Claude Opus 4.8 (1M context) --- src/Fable.Transforms/Beam/Replacements.fs | 17 ++++- tests/Beam/ArithmeticTests.fs | 84 +++++++++++++++++++++++ 2 files changed, 99 insertions(+), 2 deletions(-) diff --git a/src/Fable.Transforms/Beam/Replacements.fs b/src/Fable.Transforms/Beam/Replacements.fs index 86dc53fe2..9c61325f2 100644 --- a/src/Fable.Transforms/Beam/Replacements.fs +++ b/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 diff --git a/tests/Beam/ArithmeticTests.fs b/tests/Beam/ArithmeticTests.fs index 75b8ca870..647354b1b 100644 --- a/tests/Beam/ArithmeticTests.fs +++ b/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`. +[] +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. +[] +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) + +[] +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 + +[] +let ``test BigInt from float32 truncates toward zero`` () = + let positive = 2.7f + let negative = -2.7f + bigint positive |> equal 2I + bigint negative |> equal -2I + +[] +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. +[] +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 + [] 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) + +[] +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 From 432c1b573ed02840763ab61ac7154d867b3ebd2a Mon Sep 17 00:00:00 2001 From: Dag Brattli Date: Mon, 13 Jul 2026 15:36:25 +0200 Subject: [PATCH 2/3] fix(beam): make option a union type in reflection MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Beam's type info for option carried only fullname + generics and no cases, so FSharpType.IsUnion typeof was false, GetUnionCases errored, and MakeUnion built the wrong shape — unlike every other target, where None (tag 0) and Some (tag 1) are attached to the option type. Beam's option is erased (None = undefined, Some v = v), so the generic bare-atom / tagged-tuple constructor would build `none` / `{some, V}`, which is not an option at runtime. Each case therefore carries an `erased_option` marker telling fable_reflection to build and read the native shape instead. The cases are emitted as a plain list rather than a thunk: two Erlang funs from different literals never compare equal, so type info containing an inline thunk is not comparable across construction sites, and `typeof<'a option> = typeof<'a option>` would be false. Records and unions get away with deferring because both sides call the same generated reflection function. Option's only case field is the generic arg, which resolves to a call and cannot self-recurse, so there is nothing to defer. Reflection tests covered records, unions, tuples, enums and recursive types, but never asked a built-in generic whether it is a union — option falls between "user union" and "builtin type" in that matrix. The new tests round-trip through MakeUnion against natively constructed values (inspecting case metadata alone would pass with the wrong shape), and pin type-info equality explicitly. Co-Authored-By: Claude Opus 4.8 (1M context) --- .../Beam/Fable2Beam.Reflection.fs | 34 ++++++- src/fable-library-beam/fable_reflection.erl | 44 +++++++-- tests/Beam/ReflectionTests.fs | 92 +++++++++++++++++++ 3 files changed, 163 insertions(+), 7 deletions(-) diff --git a/src/Fable.Transforms/Beam/Fable2Beam.Reflection.fs b/src/Fable.Transforms/Beam/Fable2Beam.Reflection.fs index ae34de9ef..a20504b94 100644 --- a/src/Fable.Transforms/Beam/Fable2Beam.Reflection.fs +++ b/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 diff --git a/src/fable-library-beam/fable_reflection.erl b/src/fable-library-beam/fable_reflection.erl index 8748ed88e..8d75377b8 100644 --- a/src/fable-library-beam/fable_reflection.erl +++ b/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). diff --git a/tests/Beam/ReflectionTests.fs b/tests/Beam/ReflectionTests.fs index 3216dd146..29b2aab3d 100644 --- a/tests/Beam/ReflectionTests.fs +++ b/tests/Beam/ReflectionTests.fs @@ -325,6 +325,70 @@ let ``test FSharp.Reflection: Choice`` () = FSharpValue.MakeUnion(ucis.[0], [|box 5|]) |> equal (box (Choice<_,string>.Choice1Of2 5)) FSharpValue.MakeUnion(ucis.[1], [|box "foo"|]) |> equal (box (Choice.Choice2Of2 "foo")) +// Option is erased on Beam (None is `undefined`, Some v is v), but it is a real F# union and +// reflection has to report it as one. See https://github.com/fable-compiler/Fable/issues/4082 +[] +let ``test FSharp.Reflection: Option is a union type`` () = + let typ = typeof + FSharpType.IsUnion typ |> equal true + let ucis = FSharpType.GetUnionCases typ + ucis.Length |> equal 2 + ucis.[0].Name |> equal "None" + ucis.[1].Name |> equal "Some" + ucis.[0].Tag |> equal 0 + ucis.[1].Tag |> equal 1 + +[] +let ``test FSharp.Reflection: Option case fields are typed`` () = + let ucis = FSharpType.GetUnionCases typeof + ucis.[0].GetFields().Length |> equal 0 + let someFields = ucis.[1].GetFields() + someFields.Length |> equal 1 + someFields.[0].PropertyType |> equal typeof + +// MakeUnion has to build the *erased* representation. A generic union constructor would produce +// `none` / `{some, 42}`, which is not an option at runtime — so this compares against natively +// constructed values rather than merely inspecting the case metadata. +[] +let ``test FSharp.Reflection: MakeUnion builds a real option`` () = + let typ = typeof + let ucis = FSharpType.GetUnionCases typ + FSharpValue.MakeUnion(ucis.[0], [||]) |> equal (box (None: int option)) + FSharpValue.MakeUnion(ucis.[1], [|box 42|]) |> equal (box (Some 42)) + // Usable as an option afterwards, not just equal to one. + unbox (FSharpValue.MakeUnion(ucis.[1], [| box 42 |])) + |> Option.map ((+) 1) + |> equal (Some 43) + unbox (FSharpValue.MakeUnion(ucis.[0], [||])) + |> Option.isNone + |> equal true + +[] +let ``test FSharp.Reflection: GetUnionFields reads an option`` () = + let typ = typeof + let noneCase, noneFields = FSharpValue.GetUnionFields(box (None: int option), typ) + noneCase.Name |> equal "None" + noneFields.Length |> equal 0 + let someCase, someFields = FSharpValue.GetUnionFields(box (Some 42), typ) + someCase.Name |> equal "Some" + someFields.Length |> equal 1 + someFields.[0] |> equal (box 42) + +// The erased representation has to survive nesting: `Some None` is distinct from `None`, and +// neither collapses into the other. +[] +let ``test FSharp.Reflection: Option round-trips through Some(None) and Some(Some x)`` () = + let typ = typeof + let ucis = FSharpType.GetUnionCases typ + let someCase, someFields = FSharpValue.GetUnionFields(box (Some (None: int option)), typ) + someCase.Name |> equal "Some" + someFields.[0] |> equal (box (None: int option)) + let someCase2, someFields2 = FSharpValue.GetUnionFields(box (Some (Some 42)), typ) + someCase2.Name |> equal "Some" + someFields2.[0] |> equal (box (Some 42)) + FSharpValue.MakeUnion(ucis.[1], [|box (None: int option)|]) |> equal (box (Some (None: int option))) + FSharpValue.MakeUnion(ucis.[1], [|box (Some 42)|]) |> equal (box (Some (Some 42))) + [] let ``test Reflection info of int64 decimal with units of measure works`` () = typeof< int64 > = typeof< int64 > |> equal true @@ -430,6 +494,34 @@ let ``test IsUnion and IsRecord work for recursive types`` () = FSharpType.IsRecord typeof |> equal false FSharpType.IsUnion typeof |> equal false +// Structurally equal type infos must compare equal. On Beam this is a live constraint rather than a +// truism: type info is a value built at each use site, and two Erlang funs from different literals +// never compare equal — so a type whose info embeds a thunk is not comparable across sites. Option's +// cases are emitted inline, which is why they must be a plain list and not a deferred one. +[] +let ``test Type equality holds for structurally equal types`` () = + typeof = typeof |> equal true + typeof = typeof |> equal true + typeof = typeof |> equal true + typeof = typeof |> equal true + typeof = typeof |> equal true + typeof option> = typeof option> |> equal true + typeof> = typeof> |> equal true + // ...and distinct types still differ. + typeof = typeof |> equal false + typeof = typeof |> equal false + +// An option nested inside a derived structure has to be constructible reflectively too. +[] +let ``test FSharp.Reflection: MakeRecord with an option field`` () = + let typ = typeof + let inner = { Value = 2; Next = None } + let node = FSharpValue.MakeRecord(typ, [| box 1; box (Some inner) |]) |> unbox + node.Value |> equal 1 + node.Next |> equal (Some inner) + let leaf = FSharpValue.MakeRecord(typ, [| box 3; box (None: LinkedNode option) |]) |> unbox + leaf.Next |> Option.isNone |> equal true + [] let ``test MakeUnion round-trips a recursive union`` () = let cases = FSharpType.GetUnionCases typeof From 3ba1491ada8833cfb05c493e3c8b03d4489ff025 Mon Sep 17 00:00:00 2001 From: Dag Brattli Date: Mon, 13 Jul 2026 15:36:37 +0200 Subject: [PATCH 3/3] fix(beam): forward argv and the exit code through the generated main shim MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Since module names became app-qualified (#4770), a project's [] lives in _:main/1 and Fable emits a main.erl shim so runners have a stable entry module. The shim called main/0 and passed no argv, so every Beam program with an entry point died instantly with `undef`. Forwarding the argv is not enough on its own: 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. Passed straight through, argv reaches erlang:get/1 as a list, yields `undefined`, and fails with `badarg` — which only shows up in a program that actually reads its argv. The exit code has to cross back out too: an [] returning non-zero must exit non-zero, or a failing test suite reports success. halt/1 flushes stdout, so the program's output is not lost. The Beam suite calls test functions directly and never runs a program end to end, which is how the shim stayed broken while the suite was green — it is still green against the old shim. So this adds two fixture programs (one with an entry point, one with only top-level effects) that Build.Test.Beam compiles, runs on the BEAM, and checks the output and exit status of. Co-Authored-By: Claude Opus 4.8 (1M context) --- src/Fable.Build/Test/Beam.fs | 98 +++++++++++++++++++ src/Fable.Cli/Main.fs | 28 +++++- tests/Beam/Program/Program.fs | 20 ++++ tests/Beam/Program/Program.fsproj | 14 +++ tests/Beam/ProgramNoEntry/Program.fs | 6 ++ .../Beam/ProgramNoEntry/ProgramNoEntry.fsproj | 14 +++ 6 files changed, 178 insertions(+), 2 deletions(-) create mode 100644 tests/Beam/Program/Program.fs create mode 100644 tests/Beam/Program/Program.fsproj create mode 100644 tests/Beam/ProgramNoEntry/Program.fs create mode 100644 tests/Beam/ProgramNoEntry/ProgramNoEntry.fsproj diff --git a/src/Fable.Build/Test/Beam.fs b/src/Fable.Build/Test/Beam.fs index 7de9a55f0..0109cc011 100644 --- a/src/Fable.Build/Test/Beam.fs +++ b/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 [] 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 [] 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 () diff --git a/src/Fable.Cli/Main.fs b/src/Fable.Cli/Main.fs index 5a120b0b7..9adcfd787 100644 --- a/src/Fable.Cli/Main.fs +++ b/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# `[]` 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 `[]` 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 diff --git a/tests/Beam/Program/Program.fs b/tests/Beam/Program/Program.fs new file mode 100644 index 000000000..a4d16f606 --- /dev/null +++ b/tests/Beam/Program/Program.fs @@ -0,0 +1,20 @@ +/// A whole program, run end to end through the generated `main.erl` shim. +/// +/// The Beam test suite calls test functions directly, so nothing in it ever exercises the shim — +/// which is how it stayed broken while the suite was green: an F# `[]` lowers to +/// `main/1`, and the shim called `main/0`, so every Beam program with an entry point died with +/// `undef`. The runner in `Build.Test.Beam` compiles this project, runs it on the BEAM, and checks +/// what it printed and what it exited with. +module Fable.Tests.Program.Main + +[] +let main argv = + // Argv has to survive the crossing from a plain Erlang list into F#'s `string[]`. + printfn "argc=%d" argv.Length + printfn "argv=%s" (String.concat "," argv) + + // ...and the return value has to become the process exit code, or a failing suite is + // indistinguishable from a passing one. + match argv with + | [| "fail" |] -> 3 + | _ -> 0 diff --git a/tests/Beam/Program/Program.fsproj b/tests/Beam/Program/Program.fsproj new file mode 100644 index 000000000..42403eaa4 --- /dev/null +++ b/tests/Beam/Program/Program.fsproj @@ -0,0 +1,14 @@ + + + Exe + net10.0 + false + preview + + + + + + + + diff --git a/tests/Beam/ProgramNoEntry/Program.fs b/tests/Beam/ProgramNoEntry/Program.fs new file mode 100644 index 000000000..ad08c6513 --- /dev/null +++ b/tests/Beam/ProgramNoEntry/Program.fs @@ -0,0 +1,6 @@ +/// The other kind of Fable program: no `[]`, just top-level effects, which compile to +/// the entry module's `main/0`. The generated shim has to fall back to that arity — this is the +/// branch a program with an entry point never takes. +module Fable.Tests.ProgramNoEntry.Main + +printfn "no-entry-point program ran" diff --git a/tests/Beam/ProgramNoEntry/ProgramNoEntry.fsproj b/tests/Beam/ProgramNoEntry/ProgramNoEntry.fsproj new file mode 100644 index 000000000..42403eaa4 --- /dev/null +++ b/tests/Beam/ProgramNoEntry/ProgramNoEntry.fsproj @@ -0,0 +1,14 @@ + + + Exe + net10.0 + false + preview + + + + + + + +