JosephFerano/flan
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

A refusal test that passes for the wrong reason is not a test

Browse Source 
Each of the four cases asserted only that the message named the target. Every
one of those paths meets "web: no emcc on PATH" first on a machine with no
emscripten, which also names the target — so on exactly the machine where none
of the refusals ran, all four would have reported that they did. Each case now
names the phrase it expects.
This commit is contained in:
Joseph Ferano 2026-09-12 10:46:50 +07:00
parent 3e15328acd
commit a649a42faa
1 changed files with 17 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

24
test/test_web.ml
View File

@ -56,7 +56,9 @@ let cleanup html =
`link` line names it; the two relative paths are where the script puts it by `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 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 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 raylib_web () =
let cands = let cands =
(match Sys.getenv_opt "FLAN_RAYLIB_WEB" with Some s -> [ s ] | None -> []) (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 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 the existing predicate" is exactly the kind of thing that stops being true
silently. No emscripten is needed — each is refused before any compiler silently. No emscripten is needed — each is refused before any compiler
runs. *) runs.
let refused what f =
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 match f () with
| () -> fail "%s was accepted" what | () -> fail "%s was accepted" what
| exception Failure m -> | exception Failure m ->
if not (contains m "web") then if not (contains m "web") then
fail "%s was refused, but the reason does not name the target: %S" what m 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 in
let unit_main () = let unit_main () =
let path = "programs/unit-main.flan" in let path = "programs/unit-main.flan" in
let l = Load.program ~file:path (Parse.program (Reader.read_file path)) in let l = Load.program ~file:path (Parse.program (Reader.read_file path)) in
Check.program l.Load.decls Check.program l.Load.decls
in in
refused "--dev --target=web" (fun () -> refused "--dev --target=web" "--dev is native only" (fun () ->
ignore ignore
(Build.executable ~opts:{ Build.default with target = Some "web"; dev = true } (Build.executable ~opts:{ Build.default with target = Some "web"; dev = true }
(unit_main ()) ~out:(Filename.concat scratch "flan-web-dev.html"))); (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 ignore
(Build.executable (Build.executable
~opts:{ Build.default with target = Some "web"; debug = true } ~opts:{ Build.default with target = Some "web"; debug = true }
(unit_main ()) ~out:(Filename.concat scratch "flan-web-dbg.html"))); (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 ignore
(Build.executable (Build.executable
~opts:{ Build.default with target = Some "web"; sanitize = true } ~opts:{ Build.default with target = Some "web"; sanitize = true }
(unit_main ()) ~out:(Filename.concat scratch "flan-web-san.html"))); (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 ignore
(Build.shared ~opts:{ Build.default with target = Some "web" } ~ir:"" (Build.shared ~opts:{ Build.default with target = Some "web" } ~ir:""
~out:(Filename.concat scratch "flan-web.so") ())); ~out:(Filename.concat scratch "flan-web.so") ()));