diff --git a/test/test_web.ml b/test/test_web.ml index fd97a72..c1dea12 100644 --- a/test/test_web.ml +++ b/test/test_web.ml @@ -56,7 +56,9 @@ let cleanup html = `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. *) + 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 -> []) @@ -165,34 +167,42 @@ let () = 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 = + 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" (fun () -> + 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" (fun () -> + 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" (fun () -> + 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" (fun () -> + 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") ()));