Joseph Ferano
aa6087af91
765 lines to 201, at parity with lisp/sand.lisp, clojure/src/fnm/sand.clj and src/fnm/sand.jank. Gone: audio and tone synthesis, the brush textures and the embedded PNG, the render-texture scene, the HUD font, the camera, the world cursor, the HUD and the input-state read-out. None of it is in any reference version, and none of it was the language being exercised. Inlined the single-use helpers -- empty-at?, move-grain, draw-grid, paint. settle also carried an unused (rl/Vector2 ...) binding, which put raylib inside the section whose banner says there is none, and a stray (pause). The physics is untouched on purpose: the references disagree there, so parity does not name a target, and settle is what the pinned hash covers. It still prints 15595743031174623232 at -O2, -O0 and as a dev build. test_web.ml asserted brush.png's bytes reached the wasm module, proving an embed survives the web build. web-files.flan is web-built and *run* under node and asserts the embedded bytes print, which is the same property checked harder, so the sand assertion goes rather than the embed staying.
326 lines
16 KiB
OCaml
326 lines
16 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;
|
|
|
|
(* ── 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 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; 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 () =
|
|
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
|