Joseph Ferano
a649a42faa
Each of the four cases asserted only that the message named the target. Every one of those paths meets "web: no emcc on PATH" first on a machine with no emscripten, which also names the target — so on exactly the machine where none of the refusals ran, all four would have reported that they did. Each case now names the phrase it expects.
230 lines
10 KiB
OCaml
230 lines
10 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 = ref 0
|
|
|
|
let scratch = Filename.get_temp_dir_name ()
|
|
|
|
let fail fmt = Printf.ksprintf (fun s -> incr failures; print_endline ("FAIL " ^ s)) 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 hay needle =
|
|
let n = String.length needle and h = String.length hay in
|
|
let rec go i = i + n <= h && (String.sub hay i n = needle || go (i + 1)) in
|
|
go 0
|
|
|
|
let have prog = Sys.command (Printf.sprintf "command -v %s > /dev/null 2>&1" prog) = 0
|
|
|
|
(* 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 l = Load.program ~file:path (Parse.program (Reader.read_file path)) in
|
|
let p = Check.program l.Load.decls in
|
|
let p, csrcs, lflags = Reach.link l p 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;
|
|
|
|
(* ── raylib in the browser ────────────────────────────────────────
|
|
The claim 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)));
|
|
|
|
(* ── 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 () =
|
|
let path = "programs/unit-main.flan" in
|
|
let l = Load.program ~file:path (Parse.program (Reader.read_file path)) in
|
|
Check.program l.Load.decls
|
|
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
|