76270eac0d
Ten test binaries share a directory and had shared nothing in it but watchdog.ml. Everything else each one needed it wrote out again: the failure counter and its FAIL line, the three-line report tail, a poll, a socket connect, the wait for a [flan dev] daemon to bind, a substring search, and the Load -> Check -> Reach.link front half of a compile. [listening] was the clearest case. Three copies, byte for byte apart from one comment, and two of them said in that comment that they were kept separate because "these three files have no module between them". That was not true when it was written: watchdog.ml was already named in the same (modules ...) stanzas. test_support.ml is the second such module, wired the same way, and those two sentences go with the copies they were explaining. test_repl.ml's [quote] was Wire.quote character for character, in a file that already links Wire and already names Wire.quote in a comment about what the case below it is checking. It is Wire.quote now. One real behaviour change, and it is a fix. [connect] existed twice over with different retries: the agent's narrowed to ECONNREFUSED with a comment saying why -- the socket file appears at bind, a moment before listen -- while dev's and repl's retried any Unix_error, which meant an ENOENT or an EACCES was retried to the full timeout before raising something the reader still had to interpret. The shared one takes the narrow version. Every caller connects to a socket [listening] has already seen on disk, so the race it does catch is the only one left. The rest is left where it is, on purpose. The three output-capturing [run]s differ in what they wrap -- a pid suffix, a sanitizer environment, a valgrind invocation -- and are not the same function. The report tails in test_repl, test_web and the two sweep binaries print different things for different reasons. The per-file scratch prefixes are the feature that keeps two suites running at once from unlinking each other's sockets, so the shared helper takes the prefix rather than choosing one. And the [match Sys.command "command -v clang ..."] probes stay as they are: their skip lines are output this suite pins. bin/main.ml has the compile pipeline written out twice more. Left alone -- this was a test/-scoped change and bin/ should not be reaching into a test module -- and noted in FIX.org as what it actually needs, which is the pipeline moving into lib/. dune test: exit 0, and its output is the same line for line once the temp-directory hash and the millisecond counts are normalised.
314 lines
15 KiB
OCaml
314 lines
15 KiB
OCaml
(* The web target: a Flan program built for the browser by emscripten.
|
|
|
|
Headless, on purpose and permanently. Nothing here drives a browser; what a
|
|
test can honestly say about a page it never opens is that the artifact is
|
|
the shape a browser needs — three files, a wasm that is a wasm, a page that
|
|
loads the JS beside it — and that the module has the two things the target
|
|
is *for*: asyncify, so a Flan `until` loop can yield to the event loop, and
|
|
raylib's GL imports, so the loop has something to draw with.
|
|
|
|
Everything is probed rather than assumed, the same way the wasm32 case in
|
|
test_acceptance is: emscripten may not be installed, and the raylib archive
|
|
is built once by vendor/raylib/build-web.sh and is not in the tree. A missing
|
|
piece is a skip with the reason, never a red test. *)
|
|
|
|
open Flan
|
|
|
|
let failures = Test_support.failures
|
|
let scratch = Test_support.scratch
|
|
let fail fmt = Test_support.fail fmt
|
|
|
|
let read path =
|
|
let ch = open_in_bin path in
|
|
let n = in_channel_length ch in
|
|
let s = really_input_string ch n in
|
|
close_in ch; s
|
|
|
|
let contains = Test_support.contains
|
|
let have = Test_support.have
|
|
|
|
(* One web build, through [Load] and [Reach] exactly as [flan build] does it,
|
|
so a package's per-target link lines are selected here too. *)
|
|
let web_build ?(opt = "-O2") path out =
|
|
let p, csrcs, lflags = Test_support.linked path in
|
|
ignore
|
|
(Build.executable ~opts:{ Build.default with opt; target = Some "web" }
|
|
~csrcs ~lflags p ~out)
|
|
|
|
(* emcc derives the JS and the module from the page's name. *)
|
|
let parts html =
|
|
let base = Filename.remove_extension html in
|
|
(html, base ^ ".js", base ^ ".wasm")
|
|
|
|
let cleanup html =
|
|
let a, b, c = parts html in
|
|
List.iter (fun f -> try Sys.remove f with Sys_error _ -> ()) [ a; b; c ]
|
|
|
|
(* The archive vendor/raylib/build-web.sh makes. FLAN_RAYLIB_WEB is how a
|
|
`link` line names it; the two relative paths are where the script puts it by
|
|
default, seen from a test run out of _build. Found here and put back into
|
|
the environment, so that a developer who has built it once does not also
|
|
have to remember to export it before running the suite. That putenv outlives
|
|
this call, so the raylib case being the last web build in the process is
|
|
load-bearing: anything built after it would pick the archive up silently. *)
|
|
let raylib_web () =
|
|
let cands =
|
|
(match Sys.getenv_opt "FLAN_RAYLIB_WEB" with Some s -> [ s ] | None -> [])
|
|
@ [ "../../../vendor/raylib/web/libraylib-5.5.a";
|
|
"../vendor/raylib/web/libraylib-5.5.a" ]
|
|
in
|
|
match List.find_opt Sys.file_exists cands with
|
|
| Some p ->
|
|
let p = try Unix.realpath p with Unix.Unix_error _ -> p in
|
|
Unix.putenv "FLAN_RAYLIB_WEB" p;
|
|
Some p
|
|
| None -> None
|
|
|
|
let () =
|
|
(* ── The probe ─────────────────────────────────────────────────────
|
|
The smallest program there is, built for the browser. If emscripten is
|
|
absent this is where it says so, and nothing below runs. *)
|
|
let probe = Filename.concat scratch "flan-web-probe.html" in
|
|
let outcome =
|
|
match web_build "programs/unit-main.flan" probe with
|
|
| () -> Ok ()
|
|
| exception Failure m -> Error m
|
|
in
|
|
(match outcome with
|
|
| Error why -> Printf.printf "web: skipping the web target (%s)\n" why
|
|
| Ok () ->
|
|
let html, js, wasm = parts probe in
|
|
|
|
(* Three files, because that is what "openable" means: a page, the JS that
|
|
instantiates the module, and the module. *)
|
|
List.iter
|
|
(fun (what, f) ->
|
|
if not (Sys.file_exists f) then fail "web build made no %s (%s)" what f)
|
|
[ ("page", html); ("JS", js); ("module", wasm) ];
|
|
|
|
(* A wasm is a wasm. The four bytes are the whole format's claim about
|
|
itself, and an emcc that produced JS and a stub would pass every other
|
|
check here. *)
|
|
let bytes = read wasm in
|
|
if String.length bytes < 8 || String.sub bytes 0 4 <> "\000asm" then
|
|
fail "the module does not start with the wasm magic";
|
|
|
|
(* The page has to load the module's JS, or it is a page about nothing.
|
|
emcc minifies the shell, so this asks for the reference and not for any
|
|
particular spelling of the tag. *)
|
|
let page = read html in
|
|
let base = Filename.basename (Filename.remove_extension probe) in
|
|
if not (contains page (base ^ ".js")) then
|
|
fail "the page does not reference %s.js" base;
|
|
(* And it has to be *our* shell: the canvas raylib draws into, and the
|
|
Module.print that puts stdout on the page. *)
|
|
if not (contains page "canvas") then fail "the page has no canvas";
|
|
|
|
(* The one execution this test does. node runs the emitted JS without a
|
|
DOM, which is enough for a program that only prints — and it is the
|
|
same "does it actually run" the wasm32 case insists on. *)
|
|
if not (have "node") then
|
|
print_endline "web: skipping the run (no node)"
|
|
else begin
|
|
let out = Filename.concat scratch "flan-web-probe.out" in
|
|
let code =
|
|
Sys.command
|
|
(Printf.sprintf "node %s > %s 2>&1" (Filename.quote js)
|
|
(Filename.quote out))
|
|
in
|
|
let text = In_channel.with_open_bin out In_channel.input_all in
|
|
(try Sys.remove out with Sys_error _ -> ());
|
|
if code <> 0 || text <> "ok\n" then
|
|
fail "node could not run the web build: %S (exit %d)" text code
|
|
end;
|
|
cleanup probe;
|
|
|
|
(* ── Files on the web, NEXT.md decision 2 ─────────────────────────
|
|
The one case here whose *behaviour* differs from the desktop's, and it
|
|
differs with no conditional compilation anywhere: programs/web-files.flan
|
|
is built for both targets from the same text, and nothing in parse.ml or
|
|
check.ml has read the target. On the desktop it writes the file and says
|
|
so; here `barf` signals a FileError the program handles, naming the file
|
|
and the reason. The refusal lives in one #ifdef in flan_rt.c, which is
|
|
where the host ABI is already implemented twice.
|
|
|
|
This is run rather than inspected. An artifact-shape assertion would say
|
|
nothing about the thing decision 2 actually bought — that a program on
|
|
the web is *told* its write did not happen instead of quietly losing it.
|
|
|
|
`embed` is in the same program on purpose: it is the half that needs no
|
|
filesystem and no host ABI, so the same line works on both targets and
|
|
is the answer for assets a web build has to carry. *)
|
|
if not (have "node") then
|
|
print_endline "web: skipping the barf case (no node)"
|
|
else begin
|
|
let out = Filename.concat scratch "flan-web-files.html" in
|
|
(match web_build "programs/web-files.flan" out with
|
|
| exception Failure m -> fail "barf for the browser: %s" m
|
|
| () ->
|
|
let _, js, _ = parts out in
|
|
let log = Filename.concat scratch "flan-web-files.out" in
|
|
let code =
|
|
Sys.command
|
|
(Printf.sprintf "node %s > %s 2>&1" (Filename.quote js)
|
|
(Filename.quote log))
|
|
in
|
|
let text = In_channel.with_open_bin log In_channel.input_all in
|
|
(try Sys.remove log with Sys_error _ -> ());
|
|
(* The embed, byte for byte, out of the module's own data. *)
|
|
if not (contains text "hello from a") then
|
|
fail "the embedded file did not reach the web build: %S" text;
|
|
(* The refusal, naming the file and the reason, and reason 4 is
|
|
file-unsupported rather than a missing file or a denied one. *)
|
|
if not (contains text "refused: web-files-out.txt reason 4")
|
|
|| not (contains text "true") then
|
|
fail "barf did not signal on the web: %S" text;
|
|
(* And the desktop's line is absent: a silent no-op would have taken
|
|
this branch, which is the outcome decision 2 rules out by name. *)
|
|
if contains text "wrote it" then
|
|
fail "barf reported success on the web: %S" text;
|
|
if code <> 0 then
|
|
fail "the web barf case exited %d: %S" code text;
|
|
cleanup out)
|
|
end;
|
|
|
|
(* ── raylib in the browser ────────────────────────────────────────
|
|
The claim docs/BUILT.md left open. core-basic-window.flan is built for the
|
|
web unchanged — no edit to its `until` loop, which is the whole point
|
|
of choosing asyncify over emscripten_set_main_loop — and the module is
|
|
then read for the two things that prove the claim rather than assert
|
|
it: the asyncify export, and a GL import that can only have come from
|
|
raylib's web platform.
|
|
|
|
Import and export names are plain strings in a wasm's name sections,
|
|
which is why this needs no wasm reader. *)
|
|
(match raylib_web () with
|
|
| None ->
|
|
print_endline
|
|
"web: skipping the raylib case (no libraylib-5.5.a for the browser; \
|
|
run sh vendor/raylib/build-web.sh)"
|
|
| Some _ ->
|
|
let out = Filename.concat scratch "flan-web-window.html" in
|
|
(match web_build "../examples/core-basic-window.flan" out with
|
|
| exception Failure m -> fail "raylib for the browser: %s" m
|
|
| () ->
|
|
let _, _, wasm = parts out in
|
|
let bytes = read wasm in
|
|
if not (contains bytes "asyncify_start_unwind") then
|
|
fail
|
|
"no asyncify in the module — the `until` loop would block the \
|
|
browser";
|
|
if not (contains bytes "glViewport") then
|
|
fail "no GL imports in the module — raylib did not link";
|
|
cleanup out);
|
|
|
|
(* ── sand.flan, the flagship, for the browser ──────────────────
|
|
The program the whole target was wanted for, and the last web build
|
|
in this process on purpose — see [raylib_web] on why anything after
|
|
it would pick the archive up silently.
|
|
|
|
Two things had to change for this to build at all, and this case
|
|
watches both of them rather than only watching the exit code:
|
|
|
|
- The brush was (rl/load-texture "brush.png"), a bare relative path,
|
|
which means nothing on a target with no filesystem. It is an
|
|
(embed "brush.png") now, decoded through LoadImageFromMemory. The
|
|
assertion is the PNG's *own bytes*, whole, found in the module: a
|
|
build that succeeded while the embed silently emitted nothing
|
|
would pass every other check here, and "IHDR" would not do it
|
|
either — stb_image's decoder, linked in from raylib, carries that
|
|
string itself.
|
|
|
|
- The dev agent is a socket server and a browser has no sockets.
|
|
vendor/agent/flan_agent.web.c is selected over flan_agent.c here
|
|
and nowhere else. It needs no assertion of its own: flan_agent.c
|
|
does not compile under emcc at all, so a build that reached this
|
|
point compiled the stub.
|
|
|
|
Not run, and this is the ceiling rather than an omission. node has
|
|
no DOM and no WebGL, so the module instantiates, main runs, and
|
|
InitWindow dies inside glfwInit on `window is not defined` — which
|
|
says the module is live but says nothing about whether the canvas
|
|
paints. Only a human opening it can say that; docs/BUILT.md carries the
|
|
commands. *)
|
|
let out = Filename.concat scratch "flan-web-sand.html" in
|
|
(match web_build "../sand.flan" out with
|
|
| exception Failure m -> fail "sand.flan for the browser: %s" m
|
|
| () ->
|
|
let html, js, wasm = parts out in
|
|
List.iter
|
|
(fun (what, f) ->
|
|
if not (Sys.file_exists f) then
|
|
fail "the sand web build made no %s (%s)" what f)
|
|
[ ("page", html); ("JS", js); ("module", wasm) ];
|
|
let bytes = read wasm in
|
|
if not (contains bytes "asyncify_start_unwind") then
|
|
fail
|
|
"no asyncify in sand's module — its `until` loop would block the browser";
|
|
if not (contains bytes "glViewport") then
|
|
fail "no GL imports in sand's module — raylib did not link";
|
|
cleanup out)));
|
|
|
|
(* ── Refused by name ───────────────────────────────────────────────
|
|
The web target inherits every refusal wasm32 has, and for the same
|
|
reasons: the reload path is dlopen, the DWARF offsets are the host's, and
|
|
the sanitizer sweep is native. These are asserted because "it falls out of
|
|
the existing predicate" is exactly the kind of thing that stops being true
|
|
silently. No emscripten is needed — each is refused before any compiler
|
|
runs.
|
|
|
|
Each case names the phrase it expects and not merely the word "web". On a
|
|
machine with no emscripten the *first* thing every one of these paths
|
|
meets is "web: no emcc on PATH", which contains the word and is a
|
|
different failure entirely — so a looser check would report all four as
|
|
refused on exactly the machine where none of them ran. *)
|
|
let refused what why f =
|
|
match f () with
|
|
| () -> fail "%s was accepted" what
|
|
| exception Failure m ->
|
|
if not (contains m "web") then
|
|
fail "%s was refused, but the reason does not name the target: %S" what m
|
|
else if not (contains m why) then
|
|
fail "%s was refused for the wrong reason: wanted %S, said %S" what why m
|
|
in
|
|
let unit_main () = Test_support.checked "programs/unit-main.flan" in
|
|
refused "--dev --target=web" "--dev is native only" (fun () ->
|
|
ignore
|
|
(Build.executable ~opts:{ Build.default with target = Some "web"; dev = true }
|
|
(unit_main ()) ~out:(Filename.concat scratch "flan-web-dev.html")));
|
|
refused "--debug --target=web" "--debug is native only" (fun () ->
|
|
ignore
|
|
(Build.executable
|
|
~opts:{ Build.default with target = Some "web"; debug = true }
|
|
(unit_main ()) ~out:(Filename.concat scratch "flan-web-dbg.html")));
|
|
refused "--sanitize --target=web" "--sanitize is native only" (fun () ->
|
|
ignore
|
|
(Build.executable
|
|
~opts:{ Build.default with target = Some "web"; sanitize = true }
|
|
(unit_main ()) ~out:(Filename.concat scratch "flan-web-san.html")));
|
|
refused "Build.shared --target=web" "reload path is native only" (fun () ->
|
|
ignore
|
|
(Build.shared ~opts:{ Build.default with target = Some "web" } ~ir:""
|
|
~out:(Filename.concat scratch "flan-web.so") ()));
|
|
|
|
(* [flan run --target=web] is refused by the CLI rather than by [Build]: a
|
|
page is not something this host execs, and picking a browser for it is not
|
|
a decision that command has any business making. *)
|
|
let out = Filename.concat scratch "flan-web-run.out" in
|
|
let code =
|
|
Sys.command
|
|
(Printf.sprintf
|
|
"../bin/main.exe run programs/unit-main.flan --target=web > %s 2>&1"
|
|
(Filename.quote out))
|
|
in
|
|
let text = In_channel.with_open_bin out In_channel.input_all in
|
|
(try Sys.remove out with Sys_error _ -> ());
|
|
if code = 0 || not (contains text "--target is refused") then
|
|
fail "flan run --target=web was not refused: %S (exit %d)" text code;
|
|
|
|
if !failures = 0 then print_endline "web: ok"
|
|
else begin
|
|
Printf.printf "web: %d failure(s)\n" !failures;
|
|
exit 1
|
|
end
|