flan/test/test_web.ml

(* 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. *)
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. *)
  let refused what 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
  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" (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" (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" (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" (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