Three things stood between the flagship program and the web target, and each is answered here rather than worked around. The brush was a path. (rl/load-texture "brush.png") hands raylib a filename to open, and a bare relative path means nothing on a target with no filesystem. It is (embed "brush.png") now, decoded through a new binding — LoadImageFromMemory, declared (Ptr u8) plus an explicit count because the shim generator refuses a slice parameter and says so, with a Flan wrapper taking the slice apart exactly as collision-point-poly? and load-font-ex already do. One decode now serves both textures: the unflipped upload first, then ImageFlipHorizontal in place, then the mirrored one. load-texture and load-image lose their only call site in this repository; that is deliberate, because a path-based load is the thing that cannot work here. A package's C may now be addressed to one target, the way a link line already could. A .c file may carry a tag before its extension — flan_agent.web.c — and on that target it is compiled and *replaces* the untagged file of the same base name. Replacement rather than plain tagging, so that teaching a package about a new target is additive: the file that was right on three targets is not renamed to say so. Selection is in Build and not in Load, for the reason select_lflags gives. The dev agent on the web is a no-op, and the reasoning is written at length in vendor/agent/flan_agent.web.c. Short version: the agent is a socket server and a browser has no sockets, so the missing <sys/time.h> was the surface and not the cause. Refusing vendor:agent on a web target was the other candidate and is ruled out by arithmetic — Flan has no conditional compilation, sand.flan calls agent/start unconditionally, Reach cannot prune a package something reachable calls into, so a refusal means the program does not build for the browser at all. This does not contradict the `barf` decision made earlier today. `barf` is asked to make something durable, and a no-op returns success to a program that now believes bytes are on disk. The agent is asked to accept redefinitions, and on the web there is no editor, no socket and no session — --dev is refused by name on every wasm target — so there is nothing to lose. sand.flan already says the same of a native release build at the call site. test/test_web.ml builds sand.flan for the browser and reads the module for brush.png's own bytes, whole. Not "IHDR": stb_image carries that string itself, linked in from raylib, so it would pass on a build where the embed emitted nothing. It is not run — node has no DOM, so main reaches InitWindow and dies inside glfwInit on `window is not defined`, which says the module is live and nothing about whether the canvas paints. test/dune gains brush.png, because an embed is read by the checker and the headless case reaches sand.flan through ../../ from a sandboxed _build. test_session's C-c C-k case now passes ~origin, which is what both editor paths already send; omitting it was testing a request nobody makes. dune test is green. Docs follow in the next commit.
332 lines
16 KiB
OCaml
332 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";
|
|
let png = read "../brush.png" in
|
|
if String.length png = 0 then
|
|
fail "brush.png is empty, so the embed assertion below proves nothing"
|
|
else if not (contains bytes png) then
|
|
fail
|
|
"brush.png's bytes are not in sand's module — the embed did not reach the browser";
|
|
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
|