One library pipeline builds every program, one alias names the corpus, and a closed session leaves no directory behind
This commit is contained in:
commit
96314accd0
65
TODO.org
65
TODO.org
@ -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
|
||||||
|
|||||||
59
bin/main.ml
59
bin/main.ml
@ -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)))
|
||||||
|
|||||||
15
lib/build.ml
15
lib/build.ml
@ -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 ──────────────── *)
|
||||||
|
|
||||||
|
|||||||
79
lib/dev.ml
79
lib/dev.ml
@ -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
40
lib/front.ml
Normal 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 }
|
||||||
@ -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
|
||||||
|
|||||||
@ -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
215
test/dune
@ -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
|
||||||
|
|||||||
@ -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 [];
|
||||||
|
|||||||
@ -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
|
||||||
|
|||||||
@ -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
|
|
||||||
|
|||||||
@ -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
|
||||||
|
|||||||
Loading…
x
Reference in New Issue
Block a user