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. 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)));

  (* ── 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