One library pipeline builds every program, one alias names the corpus, and a closed session leaves no directory behind

This commit is contained in:
Joseph Ferano 2026-09-25 08:53:45 +07:00
commit 96314accd0
12 changed files with 298 additions and 277 deletions

View File

@ -1496,11 +1496,13 @@ in a merged build that process is the program, the compiler and the listener at
once. It reported as a connection refusal on a path that plainly existed, which once. It reported as a connection refusal on a path that plainly existed, which
misdirected two investigations. misdirected two investigations.
** TODO The daemon leaves its temp directory behind ** DONE The daemon leaves its temp directory behind
About seven megabytes a session, and nothing removes it. Two deliberate non-goals CLOSED: [2026-09-25]
when it is fixed: not on a crash, because the directory is the post-mortem, and A session that ends cleanly — =close=, or the editor gone past the grace —
never another session's directory, because a stale pid is not proof of anything. removes =flan-dev-<pid>= (program, modules, agent socket) and its own
The agent socket goes with it. =Build.workdir=. Kept on a crash: the accept loop raising, or a two-process
child killed by a signal. Only the two paths named for this pid are touched;
nothing sweeps other sessions' directories.
** DONE (agent/start) takes no argument, and binds before main ** DONE (agent/start) takes no argument, and binds before main
CLOSED: [2026-09-20] CLOSED: [2026-09-20]
@ -1697,6 +1699,17 @@ flake and a flake is how a watchdog gets deleted.
The fork pool is drained before anything reads the failure count, and a nonzero The fork pool is drained before anything reads the failure count, and a nonzero
count is an exit status. A red row used to be able to print and pass. count is an exit status. A red row used to be able to print and pass.
** TODO test_dev dies on Wire.Closed after the half-write abort
Intermittent, on an unmodified tree too: the =--llvm= half-write daemon in
=test_dev.ml='s =half_written= sometimes exits before it replies to =abort=, and
=request= raises =Wire.Closed= uncaught, so test_dev ends with a fatal, no =FAIL=
line and every later row unrun.
** TODO flan build and flan run leave an empty flan-<pid> directory
=Build.workdir= is created per process and nothing removes it once the IR is
gone. The dev daemon now removes its own on a clean end; the one-shot commands do
not.
* Editor * Editor
** DONE The syntax table and the font-lock lists are read off the parser ** DONE The syntax table and the font-lock lists are read off the parser
@ -2073,29 +2086,41 @@ Deliberate, because a path-based load is the one shape the browser cannot have.
Said so it is not later read as an accident. It holds for the shipped programs Said so it is not later read as an accident. It holds for the shipped programs
rather than for the repository — a test fixture still loads an image from a path. rather than for the repository — a test fixture still loads an image from a path.
** TODO A package under test/programs needs a glob line in four places ** DONE A package under test/programs needs a glob line in four places
Four sweeps each walk the programs directory and the glob does not descend. CLOSED: [2026-09-25]
Without the line the corpus row fails with "no package at ..." and prints no One =corpus= alias in =test/dune= holds =(source_tree programs)= and the
failure line, so a grep for failures reads green over it. workspace files the corpus imports; the tests, =test_web=, =@sanitize=,
=@valgrind=, =@x86= and =@js= depend on it, and =@page= takes the same
=source_tree=. A package added under =programs/= needs no line anywhere. A build
that raises is a =FAIL= line in every sweep: the acceptance pool, the two
sanitizer binaries, and a =MISSING= count that fails both survey scripts.
** TODO The macro programs are not in the sanitizer sweep ** DONE The macro programs are not in the sanitizer sweep
That sweep runs an explicit list, not a glob, so landing the macro programs did CLOSED: [2026-09-25]
not add them. A one-line edit. The five that run — =macros=, =macro-params=, =macro-unless=, =pkg-macro=,
=prelude-macros= — are rows in =test_sanitize.ml='s list; the refused ones stay
out with the other negative cases. The list stays explicit rather than a glob.
Not yet run under the sweep: that waits for the batched =@sanitize=.
** TODO The mutation pass has not been re-run ** TODO The mutation pass has not been re-run
Sixty mutations, nineteen of which left the whole suite green; all nineteen are Sixty mutations, nineteen of which left the whole suite green; all nineteen are
closed, each re-planted and watched fail against the new test. What is open is closed, each re-planted and watched fail against the new test. What is open is
that the pass has not been run again, so nineteen is the old number. that the pass has not been run again, so nineteen is the old number.
** TODO bin/main.ml spells the compile pipeline out by hand ** DONE bin/main.ml spells the compile pipeline out by hand
Two places each do a load, a check and a link feeding the builder, where the tests CLOSED: [2026-09-25]
go through one helper. The CLI loads through its own path and checks with a =lib/front.ml= holds the load, the check and the link. =flan build=, =run=,
different entry point, so this is not a matter of calling the test module from the =emit= (both backends), =check= and =shim= go through it with =~all:true= (every error,
binary — closing it means the pipeline moving into the library. =Loc.Errors=); =Test_support.checked= and =linked= go through it without (the
first error, =Loc.Error=). The =--no-gc= and =--warn-memory= passes stay in the
CLI as a hook that sees the program before =Reach= prunes it.
** TODO Build.executable returns only its output path ** DONE Build.executable returns only its output path
The daemon recovers the host's IR file by recomputing the working directory. One CLOSED: [2026-09-25]
line away: return the path rather than recomputing it. It returns the output path and, under =keep=, the path of the IR or assembly
it kept; without =keep= that file is gone and the second half is =None=. The
two-process daemon moves the host's IR from the path it is given and no longer
recomputes =Build.workdir=.
** TODO The 2MB OFL font is not vendored ** TODO The 2MB OFL font is not vendored
One example wants a font that is OFL and redistributable; it says on screen when One example wants a font that is OFL and redistributable; it says on screen when

View File

@ -108,17 +108,13 @@ let summarise (d : Flan.Ast.decl) =
(match fn.ret with None -> "Unit" | Some _ -> "explicit") (match fn.ret with None -> "Unit" | Some _ -> "explicit")
(List.length fn.fbody) (List.length fn.fbody)
(* Every path past [parse] goes through [Load]: an import is resolved into the (* Every path past [parse] goes through [Front], and so through [Load]: an
declarations it stands for, and the package's C shim and linker arguments import is resolved into the declarations it stands for, and the package's C
come back with them. *) shim and linker arguments come back with them. Every driver here is the
(* Every driver here is the batch case, which is the one the workflow is: write batch case, which is the one the workflow is: write everything, compile at
everything, compile at the end, work through the list. So every one of them the end, work through the list. So every one of them passes [~all:true] and
asks for the whole list rather than the first thing wrong. *) asks for the whole list rather than the first thing wrong. *)
let load path : Flan.Load.t = let checked path = snd (Flan.Front.checked ~all:true path)
Flan.Load.program ~file:path
~parse:Flan.Parse.program_all (Flan.Reader.read_file path)
let checked path = Flan.Check.program_all (load path).decls
(* What the source called each parameter, per function. The typed IR refers to (* What the source called each parameter, per function. The typed IR refers to
locals by slot index and records no names — [Check] has them in its scope locals by slot index and records no names — [Check] has them in its scope
@ -658,8 +654,7 @@ let () =
List.iter List.iter
(fun path -> (fun path ->
with_errors path (fun () -> with_errors path (fun () ->
load path |> fun l -> checked path
Flan.Check.program_all l.decls
|> Flan.X86.program ~checks ~dev ~debug ~annotate |> Flan.X86.program ~checks ~dev ~debug ~annotate
|> print_string)) |> print_string))
files files
@ -675,9 +670,8 @@ let () =
List.iter List.iter
(fun path -> (fun path ->
with_errors path (fun () -> with_errors path (fun () ->
let l = load path in let l, p = Flan.Front.checked ~all:true path in
let pnames = if debug then param_names l else [] in let pnames = if debug then param_names l else [] in
let p = Flan.Check.program_all l.decls in
(* Between checking and emission, and it hands the very same program (* Between checking and emission, and it hands the very same program
on: the flag is a question asked of what was checked, never a on: the flag is a question asked of what was checked, never a
parameter of what is emitted. *) parameter of what is emitted. *)
@ -724,28 +718,30 @@ let () =
exit 2 exit 2
in in
with_errors path (fun () -> with_errors path (fun () ->
let l = load path in
let p = Flan.Check.program_all l.decls in
(* Before reachability rather than after: a dyn in a function nothing
calls is still a dyn somebody wrote, and a refusal that depended on
what [main] happened to reach would come and go as the program was
edited elsewhere. *)
if List.mem no_gc_flag rest then Flan.Check.no_gc p;
(* Before reachability too, and for the same reason: a push in a function
nothing calls is still a push somebody wrote. *)
if List.mem warn_memory_flag rest then print_memory_warnings ~file:path p;
(* The link follows the program, not the import list: a package nothing (* The link follows the program, not the import list: a package nothing
reachable calls into contributes no C and no linker argument, and its reachable calls into contributes no C and no linker argument, and its
functions are not emitted either. That is what lets one file import functions are not emitted either. That is what lets one file import
raylib and still be buildable for wasm32. *) raylib and still be buildable for wasm32. *)
let p, csrcs, lflags = Flan.Reach.link ~dev l p in let f =
Flan.Front.linked ~all:true ~dev path ~before_link:(fun p ->
(* Before reachability rather than after: a dyn in a function
nothing calls is still a dyn somebody wrote, and a refusal that
depended on what [main] happened to reach would come and go as
the program was edited elsewhere. *)
if List.mem no_gc_flag rest then Flan.Check.no_gc p;
(* Before reachability too, and for the same reason: a push in a
function nothing calls is still a push somebody wrote. *)
if List.mem warn_memory_flag rest then
print_memory_warnings ~file:path p)
in
ignore (Flan.Build.executable ignore (Flan.Build.executable
~opts:{ Flan.Build.default with checks; dev; debug; sanitize; ~opts:{ Flan.Build.default with checks; dev; debug; sanitize;
target; x86; target; x86;
opt = Option.value opt opt = Option.value opt
~default:Flan.Build.default.Flan.Build.opt } ~default:Flan.Build.default.Flan.Build.opt }
~csrcs ~lflags ~pnames:(if debug then param_names l else []) ~csrcs:f.csrcs ~lflags:f.lflags
p ~out)) ~pnames:(if debug then param_names f.load else [])
f.program ~out))
(* The daemon an editor talks to: one session, the program it belongs to (* The daemon an editor talks to: one session, the program it belongs to
running beside it, and a socket. Unlike [flan reload] the session persists, running beside it, and a socket. Unlike [flan reload] the session persists,
so a defonce added by one evaluation is part of what the next one is checked so a defonce added by one evaluation is part of what the next one is checked
@ -916,16 +912,15 @@ let () =
Filename.concat (Filename.get_temp_dir_name ()) Filename.concat (Filename.get_temp_dir_name ())
(Printf.sprintf "flan-run-%d" (Unix.getpid ())) (Printf.sprintf "flan-run-%d" (Unix.getpid ()))
in in
let l = load path in let f = Flan.Front.linked ~all:true path in
let p = Flan.Check.program_all l.decls in
let p, csrcs, lflags = Flan.Reach.link l p in
ignore (Flan.Build.executable ignore (Flan.Build.executable
~opts:{ Flan.Build.default with checks; debug; sanitize; ~opts:{ Flan.Build.default with checks; debug; sanitize;
x86; x86;
opt = Option.value opt opt = Option.value opt
~default:Flan.Build.default.Flan.Build.opt } ~default:Flan.Build.default.Flan.Build.opt }
~csrcs ~lflags ~pnames:(if debug then param_names l else []) ~csrcs:f.csrcs ~lflags:f.lflags
p ~out:exe); ~pnames:(if debug then param_names f.load else [])
f.program ~out:exe);
let code = let code =
Sys.command Sys.command
(String.concat " " (List.map Filename.quote (exe :: prog_args))) (String.concat " " (List.map Filename.quote (exe :: prog_args)))

View File

@ -729,7 +729,11 @@ let compile_c ~opts ?tflags ?(warn = []) ~src ~name () =
(* [csrcs] and [lflags] come from the imported packages (see [Load]): the C (* [csrcs] and [lflags] come from the imported packages (see [Load]): the C
shim a package binds through, and the arguments needed to link the library shim a package binds through, and the arguments needed to link the library
it binds to. *) it binds to.
Returns the output path and, when [opts.keep] asked for it, the path of the
IR (or, under [x86], the assembly) the build was made from. Without [keep]
that file is removed before this returns, so there is no path to give. *)
let executable ?(opts = default) ?(csrcs = []) ?(lflags = []) ?(pnames = []) let executable ?(opts = default) ?(csrcs = []) ?(lflags = []) ?(pnames = [])
(p : Tast.program) ~out = (p : Tast.program) ~out =
(* The JS dialect leaves here, before anything that assumes a clang. Its (* The JS dialect leaves here, before anything that assumes a clang. Its
@ -749,7 +753,7 @@ let executable ?(opts = default) ?(csrcs = []) ?(lflags = []) ?(pnames = [])
if opts.x86 then if opts.x86 then
failwith "js: --x86 and --target=js are two different backends — pick one"; failwith "js: --x86 and --target=js are two different backends — pick one";
write out (Js.program ~checks:opts.checks p); write out (Js.program ~checks:opts.checks p);
out (out, None)
end end
else else
(* A dev build is the REPL's, and the REPL reaches a running process through (* A dev build is the REPL's, and the REPL reaches a running process through
@ -943,8 +947,11 @@ let executable ?(opts = default) ?(csrcs = []) ?(lflags = []) ?(pnames = [])
let code = Sys.command cmd in let code = Sys.command cmd in
if code <> 0 then if code <> 0 then
failwith (Printf.sprintf "%s failed (exit %d); the IR is at %s" clang code ll); failwith (Printf.sprintf "%s failed (exit %d); the IR is at %s" clang code ll);
if not opts.keep then (try Sys.remove ll with Sys_error _ -> ()); if opts.keep then (out, Some ll)
out else begin
(try Sys.remove ll with Sys_error _ -> ());
(out, None)
end
(* ── The dev path: one function into a loadable object ──────────────── *) (* ── The dev path: one function into a loadable object ──────────────── *)

View File

@ -64,6 +64,10 @@ type t = {
again ([eval]) and when a re-run is accepted ([rerun]), so the next park again ([eval]) and when a re-run is accepted ([rerun]), so the next park
is a new one and gets the whole sentence. *) is a new one and gets the whole sentence. *)
mutable park_noted : bool; mutable park_noted : bool;
(* How the two-process daemon's child ended, once [liveness] has reaped it.
A signal here is a crash, and a crash keeps [dir] on disk: see
[remove_session_dirs]. *)
mutable died : Unix.process_status option;
} }
(* The program's stdout is a pipe into this process, so that an editor can see (* The program's stdout is a pipe into this process, so that an editor can see
@ -566,7 +570,7 @@ let liveness t =
Some Some
(match Unix.waitpid [ Unix.WNOHANG ] child with (match Unix.waitpid [ Unix.WNOHANG ] child with
| 0, _ -> true | 0, _ -> true
| _ -> false | _, status -> t.died <- Some status; false
| exception Unix.Unix_error _ -> false) | exception Unix.Unix_error _ -> false)
in in
liveness_of ~child_alive ~finished:t.finished ~program:(Program.state ()) liveness_of ~child_alive ~finished:t.finished ~program:(Program.state ())
@ -4283,6 +4287,29 @@ let accept_loop ?grace t ls =
in in
go () go ()
(* A session that ended cleanly takes its directories with it: [t.dir], which
holds the program, every module it was sent and the agent's socket, and
[Build.workdir], which holds what the builds left there. Both are named for
this process's pid, so both are this session's and no other's. Nothing looks
further than those two paths — a stale pid in another directory's name is
not proof that its session is over.
Called only on the way out of a clean end. A crash leaves both where they
are, because they are what there is to look at afterwards: the IR the
program was built from and the modules it was running. *)
let remove_session_dirs t =
let rec remove path =
match (Unix.lstat path).Unix.st_kind with
| Unix.S_DIR ->
Array.iter (fun n -> remove (Filename.concat path n))
(try Sys.readdir path with Sys_error _ -> [||]);
(try Unix.rmdir path with Unix.Unix_error _ -> ())
| _ -> (try Unix.unlink path with Unix.Unix_error _ -> ())
| exception Unix.Unix_error _ -> ()
in
remove t.dir;
remove (Build.workdir ())
(* [debug] is off by default, which keeps [flan dev] exactly what it was: a (* [debug] is off by default, which keeps [flan dev] exactly what it was: a
-O2 host and -O2 modules. It is opt-in rather than always-on because a debug -O2 host and -O2 modules. It is opt-in rather than always-on because a debug
build is an -O0 build — [llvm.dbg.declare] describes an alloca and mem2reg build is an -O0 build — [llvm.dbg.declare] describes an alloca and mem2reg
@ -4308,28 +4335,26 @@ let two_process ?(debug = false) ?(x86 = true) ~file ~sock () =
actually given, not a second emission of it, which is the difference actually given, not a second emission of it, which is the difference
between showing what the process was built from and showing what it between showing what the process was built from and showing what it
probably was. [Build.executable] leaves it in its own working directory probably was. [Build.executable] leaves it in its own working directory
under the module's basename; it is moved here so that nothing else in this and says where; it is moved here so that nothing else in this process can
process can reuse the name. *) reuse the name. *)
(* The host and the modules are one decision. DWARF in a redefinition is (* The host and the modules are one decision. DWARF in a redefinition is
only half a debuggable dev loop: lldb re-resolves a *name* breakpoint only half a debuggable dev loop: lldb re-resolves a *name* breakpoint
against each module as it loads either way, but a breakpoint set on a line against each module as it loads either way, but a breakpoint set on a line
in the .flan buffer needs a line table on both sides — the host's to fire in the .flan buffer needs a line table on both sides — the host's to fire
before the first C-c C-c, the module's to follow the reload. *) before the first C-c C-c, the module's to follow the reload. *)
ignore let _, kept =
(Build.executable Build.executable
~opts:{ Build.default with Build.dev = true; Build.keep = true; ~opts:{ Build.default with Build.dev = true; Build.keep = true;
Build.debug; Build.x86 } Build.debug; Build.x86 }
~csrcs:l.Load.csrcs ~lflags:l.Load.lflags session.Session.host ~out:exe); ~csrcs:l.Load.csrcs ~lflags:l.Load.lflags session.Session.host ~out:exe
in
(* Host and modules are chosen together, which is the whole licence: an (* Host and modules are chosen together, which is the whole licence: an
[--x86] host gets [--x86] modules because one flag set both, and the [--x86] host gets [--x86] modules because one flag set both, and the
source [Build.executable] kept is assembly rather than IR. *) source [Build.executable] kept is assembly rather than IR. *)
let host_ll = Filename.concat dir (if x86 then "host.s" else "host.ll") in let host_ll = Filename.concat dir (if x86 then "host.s" else "host.ll") in
(try (match kept with
Sys.rename | Some src -> (try Sys.rename src host_ll with Sys_error _ -> ())
(Filename.concat (Build.workdir ()) | None -> ());
(Filename.basename exe ^ if x86 then ".s" else ".ll"))
host_ll
with Sys_error _ -> ());
let agent = Filename.concat dir "agent.sock" in let agent = Filename.concat dir "agent.sock" in
(* The program's source names some socket path; the daemon is the one that (* The program's source names some socket path; the daemon is the one that
@ -4379,7 +4404,7 @@ let two_process ?(debug = false) ?(x86 = true) ~file ~sock () =
{ session; child = Some child; agent; dir; stdout = rd; { session; child = Some child; agent; dir; stdout = rd;
out = Buffer.create 4096; n = 0; gen = 0; owners = Hashtbl.create 32; out = Buffer.create 4096; n = 0; gen = 0; owners = Hashtbl.create 32;
host_ll; host_exe = exe; finished = false; agent_watch = None; host_ll; host_exe = exe; finished = false; agent_watch = None;
park_noted = false } park_noted = false; died = None }
in in
ignore_sigpipe (); ignore_sigpipe ();
(try Unix.unlink sock with Unix.Unix_error _ -> ()); (try Unix.unlink sock with Unix.Unix_error _ -> ());
@ -4394,7 +4419,13 @@ let two_process ?(debug = false) ?(x86 = true) ~file ~sock () =
(try Unix.close ls with Unix.Unix_error _ -> ()); (try Unix.close ls with Unix.Unix_error _ -> ());
(try Unix.close rd with Unix.Unix_error _ -> ()); (try Unix.close rd with Unix.Unix_error _ -> ());
(try Unix.unlink sock with Unix.Unix_error _ -> ())) (try Unix.unlink sock with Unix.Unix_error _ -> ()))
(fun () -> accept_loop t ls) (fun () -> accept_loop t ls);
(* Here only when the loop returned: an exception out of it has already
left through the [finally]. A child killed by a signal is the crash that
keeps the directory. *)
match t.died with
| Some (Unix.WSIGNALED _) -> ()
| _ -> remove_session_dirs t
(* ── One process: the program and the compiler in the same binary ──── *) (* ── One process: the program and the compiler in the same binary ──── *)
@ -5214,7 +5245,7 @@ let merged_setup () =
{ session; child = None; agent; dir; stdout = rd; { session; child = None; agent; dir; stdout = rd;
out = Buffer.create 4096; n = 0; gen = 0; owners = Hashtbl.create 32; out = Buffer.create 4096; n = 0; gen = 0; owners = Hashtbl.create 32;
host_ll; host_exe = exe; finished = false; agent_watch = None; host_ll; host_exe = exe; finished = false; agent_watch = None;
park_noted = false } park_noted = false; died = None }
in in
ignore_sigpipe (); ignore_sigpipe ();
(try Unix.unlink sock with Unix.Unix_error _ -> ()); (try Unix.unlink sock with Unix.Unix_error _ -> ());
@ -5270,12 +5301,18 @@ let merged_serve () =
this process. See [agent_check] for where the sentence is said now, and this process. See [agent_check] for where the sentence is said now, and
[eval] for what a delivery to such a program honestly reports. *) [eval] for what a delivery to such a program honestly reports. *)
t.agent_watch <- Some (Unix.gettimeofday () +. 10.); t.agent_watch <- Some (Unix.gettimeofday () +. 10.);
(match accept_loop t ls with let clean =
| () -> () match accept_loop t ls with
| exception e -> | () -> true
Printf.eprintf "flan dev: %s\n%!" (Printexc.to_string e)); | exception e ->
Printf.eprintf "flan dev: %s\n%!" (Printexc.to_string e);
false
in
(try Unix.close ls with Unix.Unix_error _ -> ()); (try Unix.close ls with Unix.Unix_error _ -> ());
(try Unix.unlink sock with Unix.Unix_error _ -> ()); (try Unix.unlink sock with Unix.Unix_error _ -> ());
(* The program is this process, so a program that crashed never gets here;
the one end that does and is not clean is the loop raising. *)
if clean then remove_session_dirs t;
(* [close] from the editor ends the session, and so now does an editor that (* [close] from the editor ends the session, and so now does an editor that
stopped being there; in one process either means the program too — which stopped being there; in one process either means the program too — which
is what the daemon did by killing its child. [_exit] for the loader-lock is what the daemon did by killing its child. [_exit] for the loader-lock

40
lib/front.ml Normal file
View File

@ -0,0 +1,40 @@
(** The front half of a compile: read a file, load it with its imports, check
it, and decide the link. What [flan build], [flan run], [flan emit] and
[flan check] do before a backend is reached, and what the test binaries do
before theirs, so that the two cannot drift apart.
[all] chooses how a refusal is reported. With it, the parser and the
checker keep going and raise [Loc.Errors] with every declaration they
refused, which is what the command-line drivers want: write everything,
compile at the end, work through the list. Without it they stop at the
first and raise [Loc.Error], which is what a test asserting on one message
wants. For a program with no errors the two are the same. *)
let load ?(all = false) path : Load.t =
Load.program ~file:path
~parse:(if all then Parse.program_all else Parse.program)
(Reader.read_file path)
let check ?(all = false) (l : Load.t) : Tast.program =
(if all then Check.program_all else Check.program) l.Load.decls
let checked ?all path =
let l = load ?all path in
(l, check ?all l)
type linked = {
load : Load.t; (* the declarations, as loaded *)
program : Tast.program; (* checked, and pruned to what is reached *)
csrcs : string list; (* the packages' C that the link needs *)
lflags : string list; (* ...and their linker arguments *)
}
(* [before_link] sees the checked program before [Reach.link] prunes it. The
questions asked there — [Check.no_gc], the memory warnings — are about what
was written, and a function nothing calls is still something somebody
wrote. *)
let linked ?(dev = false) ?all ?(before_link = fun _ -> ()) path =
let l, p = checked ?all path in
before_link p;
let program, csrcs, lflags = Reach.link ~dev l p in
{ load = l; program; csrcs; lflags }

View File

@ -17,12 +17,13 @@
# DIFFER, which is a wrong answer, and a CRASH, which is a program the backend # DIFFER, which is a wrong answer, and a CRASH, which is a program the backend
# emitted and node would not run. # emitted and node would not run.
# #
# Five outcomes: # Six outcomes:
# #
# MATCH built both ways, same stdout, same stderr, same exit status # MATCH built both ways, same stdout, same stderr, same exit status
# DIFFER built both ways, and disagreed # DIFFER built both ways, and disagreed
# REFUSED Js.Unsupported -- named by the backend, with a location (exit 3) # REFUSED Js.Unsupported -- named by the backend, with a location (exit 3)
# CRASH emitted JS that node refused to run, or that threw # CRASH emitted JS that node refused to run, or that threw
# MISSING imports a package the build tree does not have; a failure
# SKIP no main, does not compile at all, or does not terminate # SKIP no main, does not compile at all, or does not terminate
# #
# Over test/programs, and over spike/js's own probes, which are here for the # Over test/programs, and over spike/js's own probes, which are here for the
@ -78,7 +79,7 @@ TIMEOUT=${TIMEOUT:-20}
# and neither answer is defined. Nothing else changes. # and neither answer is defined. Nothing else changes.
read -r -a extra <<<"${SURVEY_FLAGS:-}" read -r -a extra <<<"${SURVEY_FLAGS:-}"
declare -a match=() differ=() refused=() crash=() skip=() declare -a match=() differ=() refused=() crash=() skip=() missing=()
for src in "$corpus"/test/programs/*.flan "$corpus"/spike/js/*.flan; do for src in "$corpus"/test/programs/*.flan "$corpus"/spike/js/*.flan; do
name=$(basename "$src" .flan) name=$(basename "$src" .flan)
@ -93,7 +94,12 @@ for src in "$corpus"/test/programs/*.flan "$corpus"/spike/js/*.flan; do
# this backend's business -- the frontend refused it either way. # this backend's business -- the frontend refused it either way.
if ! "$flan" build "$src" "${extra[@]}" -o "$out/$name.llvm" \ if ! "$flan" build "$src" "${extra[@]}" -o "$out/$name.llvm" \
>"$out/$name.llvm.err" 2>&1; then >"$out/$name.llvm.err" 2>&1; then
if grep -q "in function \`_start\|undefined reference to \`main\|crt1.o" "$out/$name.llvm.err"; then # A package the build tree does not have is not the frontend refusing
# the program: it is a sweep that did not look at it, and it is counted
# as that rather than folded into the skips.
if grep -q "no package at" "$out/$name.llvm.err"; then
missing+=("$name:$(grep -m1 -o 'no package at [^ ]*' "$out/$name.llvm.err")")
elif grep -q "in function \`_start\|undefined reference to \`main\|crt1.o" "$out/$name.llvm.err"; then
skip+=("$name:no-main") skip+=("$name:no-main")
else else
skip+=("$name:does-not-compile") skip+=("$name:does-not-compile")
@ -152,6 +158,8 @@ if [ "${#refused[@]}" != 0 ] && [ "${SURVEY_QUIET:-}" != 1 ]; then
fi fi
echo "CRASH ${#crash[@]}" echo "CRASH ${#crash[@]}"
[ "${#crash[@]}" = 0 ] || printf ' %s\n' "${crash[@]}" [ "${#crash[@]}" = 0 ] || printf ' %s\n' "${crash[@]}"
echo "MISSING ${#missing[@]}"
[ "${#missing[@]}" = 0 ] || printf ' %s\n' "${missing[@]}"
echo "SKIP ${#skip[@]}" echo "SKIP ${#skip[@]}"
if [ "${#skip[@]}" != 0 ] && [ "${SURVEY_QUIET:-}" != 1 ]; then if [ "${#skip[@]}" != 0 ] && [ "${SURVEY_QUIET:-}" != 1 ]; then
printf '%s\n' "${skip[@]}" | sed 's/^[^:]*://' | sort | uniq -c \ printf '%s\n' "${skip[@]}" | sed 's/^[^:]*://' | sort | uniq -c \
@ -161,9 +169,11 @@ fi
# Strict mode, for the @js alias. A refusal is *not* a failure here -- see the # Strict mode, for the @js alias. A refusal is *not* a failure here -- see the
# header -- so only a wrong answer and a program node could not run are. # header -- so only a wrong answer and a program node could not run are.
if [ "${SURVEY_STRICT:-}" = 1 ]; then if [ "${SURVEY_STRICT:-}" = 1 ]; then
if [ "${#differ[@]}" != 0 ] || [ "${#crash[@]}" != 0 ]; then if [ "${#differ[@]}" != 0 ] || [ "${#crash[@]}" != 0 ] \
|| [ "${#missing[@]}" != 0 ]; then
echo echo
echo "js survey FAILED: ${#differ[@]} differ, ${#crash[@]} crash" echo "js survey FAILED: ${#differ[@]} differ, ${#crash[@]} crash, \
${#missing[@]} missing a package"
exit 1 exit 1
fi fi
echo echo

View File

@ -20,12 +20,13 @@
# compared a checked build against an unchecked one would say nothing about # compared a checked build against an unchecked one would say nothing about
# bounds.flan, which is the one program the two backends disagreed about. # bounds.flan, which is the one program the two backends disagreed about.
# #
# Five outcomes, and the third is the progress meter: # Six outcomes, and the third is the progress meter:
# #
# MATCH built both ways, same stdout, same stderr, same exit status # MATCH built both ways, same stdout, same stderr, same exit status
# DIFFER built both ways, and disagreed # DIFFER built both ways, and disagreed
# REFUSED X86.Unsupported -- a node this backend does not lower (exit 3) # REFUSED X86.Unsupported -- a node this backend does not lower (exit 3)
# NOX86 failed to build through --x86 for some other reason # NOX86 failed to build through --x86 for some other reason
# MISSING imports a package the build tree does not have; a failure
# SKIP no main, does not compile at all, or does not terminate # SKIP no main, does not compile at all, or does not terminate
# #
# Over test/programs, over spike/x86's own probes, which are here for the paths # Over test/programs, over spike/x86's own probes, which are here for the paths
@ -127,7 +128,7 @@ TIMEOUT=${TIMEOUT:-20}
# Off by default, so the counts above the line stay the same measurement. # Off by default, so the counts above the line stay the same measurement.
read -r -a extra <<<"${SURVEY_FLAGS:-}" read -r -a extra <<<"${SURVEY_FLAGS:-}"
declare -a match=() differ=() refused=() nox86=() skip=() declare -a match=() differ=() refused=() nox86=() skip=() missing=()
for src in "$corpus"/test/programs/*.flan "$corpus"/spike/x86/*.flan \ for src in "$corpus"/test/programs/*.flan "$corpus"/spike/x86/*.flan \
"$corpus"/spike/js/*.flan; do "$corpus"/spike/js/*.flan; do
@ -147,7 +148,12 @@ for src in "$corpus"/test/programs/*.flan "$corpus"/spike/x86/*.flan \
# this backend's business -- the frontend refused it either way. # this backend's business -- the frontend refused it either way.
if ! "$flan" build "$src" "${extra[@]}" -o "$out/$name.llvm" \ if ! "$flan" build "$src" "${extra[@]}" -o "$out/$name.llvm" \
>"$out/$name.llvm.err" 2>&1; then >"$out/$name.llvm.err" 2>&1; then
if grep -q "in function \`_start\|undefined reference to \`main\|crt1.o" "$out/$name.llvm.err"; then # A package the build tree does not have is not the frontend refusing
# the program: it is a sweep that did not look at it, and it is counted
# as that rather than folded into the skips.
if grep -q "no package at" "$out/$name.llvm.err"; then
missing+=("$name:$(grep -m1 -o 'no package at [^ ]*' "$out/$name.llvm.err")")
elif grep -q "in function \`_start\|undefined reference to \`main\|crt1.o" "$out/$name.llvm.err"; then
skip+=("$name:no-main") skip+=("$name:no-main")
else else
skip+=("$name:does-not-compile") skip+=("$name:does-not-compile")
@ -198,6 +204,8 @@ if [ "${#refused[@]}" != 0 ] && [ "${SURVEY_QUIET:-}" != 1 ]; then
fi fi
echo "NOX86 ${#nox86[@]}" echo "NOX86 ${#nox86[@]}"
[ "${#nox86[@]}" = 0 ] || printf ' %s\n' "${nox86[@]}" [ "${#nox86[@]}" = 0 ] || printf ' %s\n' "${nox86[@]}"
echo "MISSING ${#missing[@]}"
[ "${#missing[@]}" = 0 ] || printf ' %s\n' "${missing[@]}"
echo "SKIP ${#skip[@]}" echo "SKIP ${#skip[@]}"
if [ "${#skip[@]}" != 0 ] && [ "${SURVEY_QUIET:-}" != 1 ]; then if [ "${#skip[@]}" != 0 ] && [ "${SURVEY_QUIET:-}" != 1 ]; then
printf '%s\n' "${skip[@]}" | sed 's/^[^:]*://' | sort | uniq -c \ printf '%s\n' "${skip[@]}" | sed 's/^[^:]*://' | sort | uniq -c \
@ -211,9 +219,11 @@ fi
# are not: the first is usually a toolchain that is not installed here, and # are not: the first is usually a toolchain that is not installed here, and
# the second is the frontend refusing the program on both sides. # the second is the frontend refusing the program on both sides.
if [ "${SURVEY_STRICT:-}" = 1 ]; then if [ "${SURVEY_STRICT:-}" = 1 ]; then
if [ "${#differ[@]}" != 0 ] || [ "${#refused[@]}" != 0 ]; then if [ "${#differ[@]}" != 0 ] || [ "${#refused[@]}" != 0 ] \
|| [ "${#missing[@]}" != 0 ]; then
echo echo
echo "x86 survey FAILED: ${#differ[@]} differ, ${#refused[@]} refused" echo "x86 survey FAILED: ${#differ[@]} differ, ${#refused[@]} refused, \
${#missing[@]} missing a package"
exit 1 exit 1
fi fi
echo echo

215
test/dune
View File

@ -1,19 +1,16 @@
(tests ; The corpus: every file a sweep over test/programs can reach, in one place.
(names test_flan test_acceptance test_reload test_agent test_session test_dev test_emacs test_repl test_cider test_dyn) ; Each stanza below that walks the programs depends on this alias rather than
; Explicit because test_sanitize lives in this directory and is not one of ; listing the files, so a package or an asset directory added under programs/
; these: two stanzas in one directory have to say which modules are whose. ; is in every sweep without a line anywhere else. source_tree rather than a
; watchdog is every binary's clock: a hanging test reports nothing, so each ; glob per directory, because glob_files does not descend and every package is
; of these arms an alarm that turns "for ever" into a failing run. test_support ; a directory.
; is the other shared module: the failure counter, the report tail, the poll, (alias
; the daemon wait and the front half of a compile, which the binaries that (name corpus)
; wanted them had each been carrying their own copy of.
(modules test_flan test_acceptance test_reload test_agent test_session
test_dev test_emacs test_repl test_cider test_dyn watchdog
test_support)
(libraries flan unix)
; The acceptance programs are part of the test corpus: if the reader, the
; parser or the checker regresses on them we want to know here, not at the CLI.
(deps (deps
(source_tree programs)
; The acceptance programs are part of the test corpus: if the reader, the
; parser or the checker regresses on them we want to know here, not at the
; CLI.
(file %{workspace_root}/calc-me.flan) (file %{workspace_root}/calc-me.flan)
(file %{workspace_root}/sand.flan) (file %{workspace_root}/sand.flan)
; The brush sheet. sand.flan no longer embeds it — the front-end was cut back ; The brush sheet. sand.flan no longer embeds it — the front-end was cut back
@ -36,50 +33,28 @@
; The ported raylib examples. Only one of them has a headless acceptance ; The ported raylib examples. Only one of them has a headless acceptance
; case, but it imports its example as a package and that example imports ; case, but it imports its example as a package and that example imports
; examples/digits.flan, so the directory has to be here whole. ; examples/digits.flan, so the directory has to be here whole.
(glob_files %{workspace_root}/examples/*) (glob_files %{workspace_root}/examples/*)))
(glob_files programs/*.flan)
; The package tree the multi-level cases import: pkg-diamond reaches shape (tests
; through area and draw, and pkg-cycle reaches a ring. Each directory is a (names test_flan test_acceptance test_reload test_agent test_session test_dev test_emacs test_repl test_cider test_dyn)
; package, so each comes whole — a glob per directory rather than one over ; Explicit because test_sanitize lives in this directory and is not one of
; programs/pkgs/*, because dune's glob does not descend. ; these: two stanzas in one directory have to say which modules are whose.
(glob_files programs/pkgs/shape/*) ; watchdog is every binary's clock: a hanging test reports nothing, so each
(glob_files programs/pkgs/area/*) ; of these arms an alarm that turns "for ever" into a failing run. test_support
(glob_files programs/pkgs/draw/*) ; is the other shared module: the failure counter, the report tail, the poll,
(glob_files programs/pkgs/ring-a/*) ; the daemon wait and the front half of a compile, which the binaries that
(glob_files programs/pkgs/ring-b/*) ; wanted them had each been carrying their own copy of.
(glob_files programs/pkgs/ring-c/*) (modules test_flan test_acceptance test_reload test_agent test_session
; The package that exports a data type, which pkg-data.flan imports. test_dev test_emacs test_repl test_cider test_dyn watchdog
(glob_files programs/pkgs/tree/*) test_support)
; The packages that declare macros: one whose macros a program calls (libraries flan unix)
; qualified, and the two whose macros do not terminate — a ring, and one (deps
; that never settles. Each is its own directory, so each needs its own glob. (alias corpus)
(glob_files programs/pkgs/mac/*)
(glob_files programs/pkgs/macring/*)
(glob_files programs/pkgs/macspin/*)
; The package whose body calls the builtin get while the program importing
; it defines a get of its own — shadow-builtin.flan, which is the pin that
; a shadow stops at the file that declared it.
(glob_files programs/pkgs/shadowed/*)
; The package whose exports are generic, which pkg-generic.flan and
; pkg-generic-reject.flan import: the body has to be present where the copy
; is made, so the directory comes whole like every other package.
(glob_files programs/pkgs/gen/*)
; The synthetic C header the importer's table reads. Committed rather than ; The synthetic C header the importer's table reads. Committed rather than
; reached for on the machine: the raylib case needs raylib installed, at the ; reached for on the machine: the raylib case needs raylib installed, at the
; right version, with a variable set, so it skips everywhere and covers ; right version, with a variable set, so it skips everywhere and covers
; nothing. This one does not move. ; nothing. This one does not move.
(glob_files headers/*.h) (glob_files headers/*.h)
; The files programs/embed.flan bakes in. An embed reads them at *compile*
; time, so they are a dependency of the checker run and not of the program.
(glob_files programs/assets/*)
; And the tileset programs/edn-read.flan bakes in, which is under assets/ and
; not in it: embed.flan holds (embed-dir "assets") in a [3 EmbedFile], so a
; fourth file beside those three is a type error in an unrelated program.
; embed-dir does not descend and neither does a glob, so this is its own line.
(glob_files programs/assets/edn/*)
; And the config programs/json-provide.flan derives a struct from, under
; assets/ for the same reason and needing its own line for the same one.
(glob_files programs/assets/json/*)
; The reload primitive's host: a C main that dlopens what Build.shared made. ; The reload primitive's host: a C main that dlopens what Build.shared made.
(file reload_host.c) (file reload_host.c)
; A shared object that is not a redefinition module, for the agent's refusal ; A shared object that is not a redefinition module, for the agent's refusal
@ -89,8 +64,8 @@
; reaches, driven directly. ; reaches, driven directly.
(file dev_limits.c) (file dev_limits.c)
; And the third: the dynamic-value runtime, which has no Flan spelling yet ; And the third: the dynamic-value runtime, which has no Flan spelling yet
; at all. Its host program is under programs/ and is picked up by the glob ; at all. Its host program is under programs/ and comes in with the
; above; the header dyn_ops.c includes is the compiler's, dropped into the ; corpus; the header dyn_ops.c includes is the compiler's, dropped into the
; build directory beside each translation unit, so it is not a dependency ; build directory beside each translation unit, so it is not a dependency
; here. ; here.
(file dyn_ops.c) (file dyn_ops.c)
@ -115,20 +90,7 @@
(modules test_web test_support) (modules test_web test_support)
(libraries flan unix) (libraries flan unix)
(deps (deps
(glob_files programs/*.flan) (alias corpus)
(glob_files programs/assets/*)
(glob_files programs/assets/edn/*)
(glob_files programs/assets/json/*)
; The raylib bindings and the ported example the raylib case builds. The
; example imports examples/digits.flan, so the directory comes whole.
(glob_files %{workspace_root}/vendor/raylib/*)
(glob_files %{workspace_root}/examples/*)
; sand.flan for the browser, with the sheet it embeds and the dev agent it
; imports — the agent's directory has to be whole, because the file that
; makes a web build possible is the one Build selects out of it.
(file %{workspace_root}/sand.flan)
(file %{workspace_root}/brush.png)
(glob_files %{workspace_root}/vendor/agent/*)
; flan run --target=web is refused by the CLI, so the CLI has to be here. ; flan run --target=web is refused by the CLI, so the CLI has to be here.
(file %{workspace_root}/bin/main.exe))) (file %{workspace_root}/bin/main.exe)))
@ -149,18 +111,8 @@
(rule (rule
(alias sanitize) (alias sanitize)
(deps (deps
(alias corpus)
test_sanitize.exe test_sanitize.exe
(file %{workspace_root}/calc-me.flan)
(file %{workspace_root}/sand.flan)
(file %{workspace_root}/brush.png)
(glob_files %{workspace_root}/vendor/raylib/*)
(glob_files %{workspace_root}/vendor/agent/*)
(glob_files %{workspace_root}/vendor/edn/*)
(glob_files %{workspace_root}/vendor/json/*)
(glob_files %{workspace_root}/examples/*)
(glob_files programs/*.flan)
(glob_files programs/assets/*)
(glob_files programs/assets/edn/*)
; p13-dyn-collect.flan, which lives with the x86 probes because that is the ; p13-dyn-collect.flan, which lives with the x86 probes because that is the
; lane that wrote it, and is in this sweep because of what it does rather ; lane that wrote it, and is in this sweep because of what it does rather
; than where it is: it is the only program anywhere that allocates past ; than where it is: it is the only program anywhere that allocates past
@ -172,16 +124,7 @@
; a Flan program: flan_dyn.c has no Flan spelling yet. It is also the one ; a Flan program: flan_dyn.c has no Flan spelling yet. It is also the one
; translation unit here that frees the most, which is what makes it worth a ; translation unit here that frees the most, which is what makes it worth a
; sanitized run at all. See [dyn_sweep]. ; sanitized run at all. See [dyn_sweep].
(file dyn_ops.c) (file dyn_ops.c))
(glob_files programs/assets/json/*)
; The package tree pkg-diamond.flan imports — it reaches shape through area
; and draw — a glob per directory because dune's glob does not descend.
; Missing until now, and the alias only looked green because `dune test` had
; run first and left the directories in _build: from a clean tree the sweep
; died on pkg-diamond before it reached a single sanitized run.
(glob_files programs/pkgs/shape/*)
(glob_files programs/pkgs/area/*)
(glob_files programs/pkgs/draw/*))
(action (run ./test_sanitize.exe))) (action (run ./test_sanitize.exe)))
; The corpus a third time, under Valgrind's memcheck. Its own alias for the ; The corpus a third time, under Valgrind's memcheck. Its own alias for the
@ -204,38 +147,11 @@
(rule (rule
(alias valgrind) (alias valgrind)
(deps (deps
(alias corpus)
test_valgrind.exe test_valgrind.exe
; The suppression file, which is all reasons and no suppressions; its own ; The suppression file, which is all reasons and no suppressions; its own
; header says why that is the finding rather than an oversight. ; header says why that is the finding rather than an oversight.
(file valgrind.supp) (file valgrind.supp))
(file %{workspace_root}/calc-me.flan)
(file %{workspace_root}/sand.flan)
(file %{workspace_root}/brush.png)
(glob_files %{workspace_root}/vendor/raylib/*)
(glob_files %{workspace_root}/vendor/agent/*)
(glob_files %{workspace_root}/vendor/edn/*)
(glob_files %{workspace_root}/vendor/json/*)
(glob_files %{workspace_root}/examples/*)
(glob_files programs/*.flan)
(glob_files programs/assets/*)
(glob_files programs/assets/edn/*)
(glob_files programs/assets/json/*)
; The package tree the multi-level cases import, as in the test stanza
; above: a glob per directory, because dune's glob does not descend.
(glob_files programs/pkgs/shape/*)
(glob_files programs/pkgs/area/*)
(glob_files programs/pkgs/draw/*)
(glob_files programs/pkgs/ring-a/*)
(glob_files programs/pkgs/ring-b/*)
(glob_files programs/pkgs/ring-c/*)
(glob_files programs/pkgs/tree/*)
; And the macro-declaring packages, for the same reason.
(glob_files programs/pkgs/mac/*)
(glob_files programs/pkgs/macring/*)
(glob_files programs/pkgs/macspin/*)
; And the package shadow-builtin.flan imports.
(glob_files programs/pkgs/shadowed/*)
(glob_files programs/pkgs/gen/*))
(action (run ./test_valgrind.exe))) (action (run ./test_valgrind.exe)))
; The corpus a fourth time, through the hand-written x86-64 backend, compared ; The corpus a fourth time, through the hand-written x86-64 backend, compared
@ -262,6 +178,7 @@
(rule (rule
(alias x86) (alias x86)
(deps (deps
(alias corpus)
(file %{workspace_root}/spike/x86/survey.sh) (file %{workspace_root}/spike/x86/survey.sh)
(glob_files %{workspace_root}/spike/x86/*.flan) (glob_files %{workspace_root}/spike/x86/*.flan)
; The js spike's programs are plain flan programs and the sweep reads them ; The js spike's programs are plain flan programs and the sweep reads them
@ -269,33 +186,7 @@
; the glob matches nothing, and nothing is exactly what it was reporting ; the glob matches nothing, and nothing is exactly what it was reporting
; while p1-int-semantics.flan sat there with a wrong shift in it. ; while p1-int-semantics.flan sat there with a wrong shift in it.
(glob_files %{workspace_root}/spike/js/*.flan) (glob_files %{workspace_root}/spike/js/*.flan)
(file %{workspace_root}/bin/main.exe) (file %{workspace_root}/bin/main.exe))
(file %{workspace_root}/calc-me.flan)
(file %{workspace_root}/sand.flan)
(file %{workspace_root}/brush.png)
(glob_files %{workspace_root}/vendor/raylib/*)
(glob_files %{workspace_root}/vendor/agent/*)
(glob_files %{workspace_root}/vendor/edn/*)
(glob_files %{workspace_root}/vendor/json/*)
(glob_files %{workspace_root}/examples/*)
(glob_files programs/*.flan)
(glob_files programs/assets/*)
(glob_files programs/assets/edn/*)
(glob_files programs/assets/json/*)
; A glob per package directory, because dune's glob does not descend.
(glob_files programs/pkgs/shape/*)
(glob_files programs/pkgs/area/*)
(glob_files programs/pkgs/draw/*)
(glob_files programs/pkgs/ring-a/*)
(glob_files programs/pkgs/ring-b/*)
(glob_files programs/pkgs/ring-c/*)
(glob_files programs/pkgs/tree/*)
(glob_files programs/pkgs/mac/*)
(glob_files programs/pkgs/macring/*)
(glob_files programs/pkgs/macspin/*)
; And the package shadow-builtin.flan imports.
(glob_files programs/pkgs/shadowed/*)
(glob_files programs/pkgs/gen/*))
(action (action
(setenv SURVEY_STRICT 1 (setenv SURVEY_STRICT 1
(setenv SURVEY_QUIET 1 (setenv SURVEY_QUIET 1
@ -344,7 +235,7 @@
(file %{workspace_root}/calc-me.flan) (file %{workspace_root}/calc-me.flan)
(file %{workspace_root}/conditions.org) (file %{workspace_root}/conditions.org)
(glob_files %{workspace_root}/emacs/*.el) (glob_files %{workspace_root}/emacs/*.el)
(glob_files programs/*.flan) (source_tree programs)
; And sand.flan itself, which the hash comes from: quotes.sh runs ; And sand.flan itself, which the hash comes from: quotes.sh runs
; test/programs/sand-headless.flan and that imports ../../sand.flan as a ; test/programs/sand-headless.flan and that imports ../../sand.flan as a
; single-file package. Missing until now, the same hole @sanitize had — the ; single-file package. Missing until now, the same hole @sanitize had — the
@ -445,34 +336,10 @@
(rule (rule
(alias js) (alias js)
(deps (deps
(alias corpus)
(file %{workspace_root}/spike/js/survey.sh) (file %{workspace_root}/spike/js/survey.sh)
(glob_files %{workspace_root}/spike/js/*.flan) (glob_files %{workspace_root}/spike/js/*.flan)
(file %{workspace_root}/bin/main.exe) (file %{workspace_root}/bin/main.exe))
(file %{workspace_root}/calc-me.flan)
(file %{workspace_root}/sand.flan)
(file %{workspace_root}/brush.png)
(glob_files %{workspace_root}/vendor/raylib/*)
(glob_files %{workspace_root}/vendor/agent/*)
(glob_files %{workspace_root}/vendor/edn/*)
(glob_files %{workspace_root}/vendor/json/*)
(glob_files %{workspace_root}/examples/*)
(glob_files programs/*.flan)
(glob_files programs/assets/*)
(glob_files programs/assets/edn/*)
(glob_files programs/assets/json/*)
(glob_files programs/pkgs/shape/*)
(glob_files programs/pkgs/area/*)
(glob_files programs/pkgs/draw/*)
(glob_files programs/pkgs/ring-a/*)
(glob_files programs/pkgs/ring-b/*)
(glob_files programs/pkgs/ring-c/*)
(glob_files programs/pkgs/tree/*)
(glob_files programs/pkgs/mac/*)
(glob_files programs/pkgs/macring/*)
(glob_files programs/pkgs/macspin/*)
; And the package shadow-builtin.flan imports.
(glob_files programs/pkgs/shadowed/*)
(glob_files programs/pkgs/gen/*))
(action (action
(setenv SURVEY_STRICT 1 (setenv SURVEY_STRICT 1
(setenv SURVEY_QUIET 1 (setenv SURVEY_QUIET 1

View File

@ -248,7 +248,16 @@ module Pool = struct
true by construction rather than by relying on the timer-clearing true by construction rather than by relying on the timer-clearing
behaviour alone. *) behaviour alone. *)
Sys.set_signal Sys.sigalrm Sys.Signal_default; Sys.set_signal Sys.sigalrm Sys.Signal_default;
let result = try f () with e -> Some (Printexc.to_string e) in (* An exception is a failed row like any other, and says so in the same
shape: a diagnostic on its own — "no package at ..." from a package
missing from the build tree — reads as noise between passing rows. *)
let result =
try f ()
with e ->
Some
(Printf.sprintf "FAIL %s\n raised: %s\n" name
(Printexc.to_string e))
in
if result = None then cleanup_workdir (); if result = None then cleanup_workdir ();
let oc = Unix.out_channel_of_descr w in let oc = Unix.out_channel_of_descr w in
Marshal.to_channel oc result []; Marshal.to_channel oc result [];

View File

@ -97,7 +97,9 @@ let reported text = List.exists (contains text) markers
redefinition module is built by llc and ld, not by clang, so nothing redefinition module is built by llc and ld, not by clang, so nothing
instruments it — one more thing this sweep does not prove. instruments it — one more thing this sweep does not prove.
- nth-gone, pkg-hidden-main, pkg-two-aliases, pkg-two-mains, pkg-cycle, - nth-gone, pkg-hidden-main, pkg-two-aliases, pkg-two-mains, pkg-cycle,
which are negative cases and are expected not to compile. and the macro programs that are refused (macro-arity, macro-cycle,
macro-spin, macro-destructure, macro-loc-* and the pkg-macro-*
refusals), which are negative cases and are expected not to compile.
calc-me is here and is not in test/programs: it is the one string parser in calc-me is here and is not in test/programs: it is the one string parser in
the corpus, which makes it the likeliest to push [scratch] or [escaped] the corpus, which makes it the likeliest to push [scratch] or [escaped]
@ -168,6 +170,15 @@ let corpus =
block after the growth that moved it. *) block after the growth that moved it. *)
"programs/json.flan", []; "programs/json.flan", [];
"programs/machine.flan", []; "programs/machine.flan", [];
(* The macro programs that run: a macro is expanded by a module dlopened
into the compiler, but what reaches this sweep is the program the
expansion produced, which is ordinary code and can be wrong in the
ordinary ways. The ones that refuse are negative cases, below. *)
"programs/macros.flan", [];
"programs/macro-params.flan", [];
"programs/macro-unless.flan", [];
"programs/pkg-macro.flan", [];
"programs/prelude-macros.flan", [];
"programs/math.flan", []; "programs/math.flan", [];
"programs/math3.flan", []; "programs/math3.flan", [];
"programs/pkg-diamond.flan", []; "programs/pkg-diamond.flan", [];
@ -258,10 +269,13 @@ let sweep ~checks label =
List.iter List.iter
(fun (path, args) -> (fun (path, args) ->
match compile ~sanitize:false ~checks path with match compile ~sanitize:false ~checks path with
| exception Failure m -> fail "%s %s: unsanitized build: %s" label path m | exception e ->
fail "%s %s: unsanitized build: %s" label path (Test_support.raised e)
| plain -> | plain ->
(match compile ~sanitize:true ~checks path with (match compile ~sanitize:true ~checks path with
| exception Failure m -> fail "%s %s: sanitized build: %s" label path m | exception e ->
fail "%s %s: sanitized build: %s" label path
(Test_support.raised e)
| san -> | san ->
let c1, t1 = run plain args in let c1, t1 = run plain args in
let c2, t2 = run san args in let c2, t2 = run san args in

View File

@ -32,6 +32,14 @@ let failures = ref 0
let fail fmt = let fail fmt =
Printf.ksprintf (fun s -> incr failures; print_endline ("FAIL " ^ s)) fmt Printf.ksprintf (fun s -> incr failures; print_endline ("FAIL " ^ s)) fmt
(* What a build that raised says, for a [fail] line. [Failure] carries its
text bare; anything else, a [Loc.Error] most of all, goes through the
printer [Loc] registers, which is the diagnostic itself. A sweep that caught
only [Failure] died on the first source error it met — "no package at ...",
from a package the build tree was missing — with no FAIL line and every row
after it unrun. *)
let raised = function Failure m -> m | e -> Printexc.to_string e
(* The tail every suite ends on: a single line when nothing failed, and a (* The tail every suite ends on: a single line when nothing failed, and a
count plus a nonzero exit when something did. The label names the suite, count plus a nonzero exit when something did. The label names the suite,
because these binaries run under dune's parallelism and their output is because these binaries run under dune's parallelism and their output is
@ -203,14 +211,14 @@ let listening ?(ms = 30000) ~pid path =
(* ── The front half of a compile ──────────────────────────────────── *) (* ── The front half of a compile ──────────────────────────────────── *)
(* Read, load and check a program: the same two calls [flan build] makes (* Read, load and check a program, through [Front], which is the path
before it reaches the backend. Through [Load], so a program with an [flan build] takes too. Without [~all], so a refusal raises the first error
(import ...) is buildable here — it brings back the package's declarations rather than the list. Through [Load], so a program with an (import ...) is
as well as the file's own. *) buildable here — it brings back the package's declarations as well as the
let checked path = file's own. *)
Check.program (Load.program ~file:path (Reader.read_file path)).Load.decls let checked path = snd (Front.checked path)
(* And the third call, which is where the binaries below actually differ from (* And the link, which is where the binaries below actually differ from
one another: [Reach.link] decides the link from the checked program — a one another: [Reach.link] decides the link from the checked program — a
package nothing reachable calls into hands over no C and no linker package nothing reachable calls into hands over no C and no linker
argument, and its functions are not emitted — and returns the program argument, and its functions are not emitted — and returns the program
@ -220,7 +228,6 @@ let checked path =
different [Build.opts] (a sanitized build, a -O0 one, an x86 one, a web different [Build.opts] (a sanitized build, a -O0 one, an x86 one, a web
one) and several want the exception rather than the executable, so the one) and several want the exception rather than the executable, so the
options record is the one part that is genuinely theirs. *) options record is the one part that is genuinely theirs. *)
let linked ?(dev = false) path = let linked ?dev path =
let l = Load.program ~file:path (Reader.read_file path) in let f = Front.linked ?dev path in
let p = Check.program l.Load.decls in (f.Front.program, f.Front.csrcs, f.Front.lflags)
Reach.link ~dev l p

View File

@ -145,7 +145,7 @@ let clean () =
(* One program, both ways. *) (* One program, both ways. *)
let check label path args ~checks = let check label path args ~checks =
match compile ~checks path with match compile ~checks path with
| exception Failure m -> fail "%s %s: build: %s" label path m | exception e -> fail "%s %s: build: %s" label path (Test_support.raised e)
| exe -> | exe ->
clean (); clean ();
let c1, t1, _ = run exe args in let c1, t1, _ = run exe args in