mirror of
https://github.com/CatalaLang/catala.git
synced 2024-09-19 00:15:39 +03:00
1107 lines
35 KiB
OCaml
1107 lines
35 KiB
OCaml
(* This file is part of the Catala build system, a specification language for
|
|
tax and social benefits computation rules. Copyright (C) 2020 Inria,
|
|
contributors: Denis Merigoux <denis.merigoux@inria.fr>, Emile Rolley
|
|
<emile.rolley@tuta.io>
|
|
|
|
Licensed under the Apache License, Version 2.0 (the "License"); you may not
|
|
use this file except in compliance with the License. You may obtain a copy of
|
|
the License at
|
|
|
|
http://www.apache.org/licenses/LICENSE-2.0
|
|
|
|
Unless required by applicable law or agreed to in writing, software
|
|
distributed under the License is distributed on an "AS IS" BASIS, WITHOUT
|
|
WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. See the
|
|
License for the specific language governing permissions and limitations under
|
|
the License. *)
|
|
|
|
open Catala_utils
|
|
open Ninja_utils
|
|
module Nj = Ninja_utils
|
|
module Scan = Clerk_scan
|
|
|
|
(* Version is synchronised with the catala version *)
|
|
let version = Catala_utils.Cli.version
|
|
|
|
(** {1 Command line interface} *)
|
|
|
|
module Cli = struct
|
|
open Cmdliner
|
|
|
|
let catala_exe =
|
|
Arg.(
|
|
value
|
|
& opt (some string) None
|
|
& info ["e"; "exe"] ~docv:"EXE" ~doc:"Catala compiler executable.")
|
|
|
|
let catala_opts =
|
|
Arg.(
|
|
value
|
|
& opt_all string []
|
|
& info ["c"; "catala-opts"] ~docv:"FLAG"
|
|
~doc:"Option to pass to the Catala compiler. Can be repeated.")
|
|
|
|
let build_dir =
|
|
Arg.(
|
|
value
|
|
& opt (some string) None
|
|
& info ["build-dir"] ~docv:"DIR"
|
|
~doc:
|
|
"Directory where compilation artifacts should be written. Defaults \
|
|
to '_build'.")
|
|
|
|
let include_dirs =
|
|
let arg =
|
|
Arg.(
|
|
value
|
|
& opt_all (list ~sep:':' string) []
|
|
& info ["I"; "include"] ~docv:"DIR"
|
|
~env:(Cmd.Env.info "CATALA_INCLUDE")
|
|
~doc:
|
|
"Make modules from the given directory available from \
|
|
everywhere. Several dirs can be specified by repeating the flag \
|
|
or separating them with '$(b,:)'.")
|
|
in
|
|
Term.(const List.flatten $ arg)
|
|
|
|
let test_flags =
|
|
Arg.(
|
|
value
|
|
& opt (list string) []
|
|
& info ["test-flags"] ~docv:"FLAGS"
|
|
~env:(Cmd.Env.info "CATALA_TEST_FLAGS")
|
|
~doc:
|
|
"Flags to pass to the catala interpreter on $(b,catala test-scope) \
|
|
tests. Comma-separated list. A subset may also be applied to the \
|
|
compilation of modules, as needed.\n\
|
|
WARNING: flag shortcuts are not allowed here (i.e. don't use \
|
|
non-ambiguous prefixes such as $(b,--avoid-ex) for \
|
|
$(b,--avoid-exceptions))\n\
|
|
NOTE: if this is set, all inline tests that are $(i,not) \
|
|
$(b,catala test-scope) are skipped to avoid redundant testing.")
|
|
|
|
module Global : sig
|
|
val term :
|
|
(chdir:File.t option ->
|
|
catala_exe:File.t option ->
|
|
catala_opts:string list ->
|
|
build_dir:File.t option ->
|
|
include_dirs:string list ->
|
|
color:Global.when_enum ->
|
|
debug:bool ->
|
|
ninja_output:File.t option ->
|
|
'a) ->
|
|
'a Term.t
|
|
end = struct
|
|
let chdir =
|
|
Arg.(
|
|
value
|
|
& opt (some string) None
|
|
& info ["C"] ~docv:"DIR"
|
|
~doc:"Change to the given directory before processing")
|
|
|
|
let color =
|
|
Arg.(
|
|
value
|
|
& opt ~vopt:Global.Always Cli.when_opt Auto
|
|
& info ["color"]
|
|
~env:(Cmd.Env.info "CATALA_COLOR")
|
|
~doc:
|
|
"Allow output of colored and styled text. Use $(i,auto), to \
|
|
enable when the standard output is to a terminal, $(i,never) to \
|
|
disable.")
|
|
|
|
let debug =
|
|
Arg.(value & flag & info ["debug"; "d"] ~doc:"Prints debug information")
|
|
|
|
let ninja_output =
|
|
Arg.(
|
|
value
|
|
& opt (some string) None
|
|
& info ["o"; "output"] ~docv:"FILE"
|
|
~doc:
|
|
"$(i,FILE) is the file that will contain the build.ninja file \
|
|
output. If not specified, the build.ninja file is set to \
|
|
$(i,<builddir>/clerk.ninja) in debug mode, and a temporary file \
|
|
otherwise")
|
|
|
|
let term f =
|
|
Term.(
|
|
const
|
|
(fun
|
|
chdir
|
|
catala_exe
|
|
catala_opts
|
|
build_dir
|
|
include_dirs
|
|
color
|
|
debug
|
|
ninja_output
|
|
->
|
|
f ~chdir ~catala_exe ~catala_opts ~build_dir ~include_dirs ~color
|
|
~debug ~ninja_output)
|
|
$ chdir
|
|
$ catala_exe
|
|
$ catala_opts
|
|
$ build_dir
|
|
$ include_dirs
|
|
$ color
|
|
$ debug
|
|
$ ninja_output)
|
|
end
|
|
|
|
let files_or_folders =
|
|
Arg.(
|
|
value
|
|
& pos_all string []
|
|
& info [] ~docv:"FILE(S)" ~doc:"File(s) or folder(s) to process")
|
|
|
|
let single_file =
|
|
Arg.(
|
|
required
|
|
& pos 0 (some file) None
|
|
& info [] ~docv:"FILE" ~doc:"File to process")
|
|
|
|
let reset_test_outputs =
|
|
Arg.(
|
|
value
|
|
& flag
|
|
& info ["r"; "reset"]
|
|
~doc:
|
|
"Used with the `test` command, resets the test output to whatever \
|
|
is output by the Catala compiler.")
|
|
|
|
let scope =
|
|
Arg.(
|
|
required
|
|
& opt (some string) None
|
|
& info ["s"; "scope"] ~docv:"SCOPE"
|
|
~doc:
|
|
"Used with the `run` command, selects which scope of a given \
|
|
Catala file to run.")
|
|
|
|
let targets =
|
|
Arg.(
|
|
value
|
|
& pos_all string []
|
|
& info [] ~docv:"TARGETS"
|
|
~doc:
|
|
"Flags or targets to forward to Ninja directly (use $(b,-- \
|
|
ninja_flags) to separate Ninja flags from Clerk flags)")
|
|
|
|
let ninja_flags =
|
|
let env =
|
|
Cmd.Env.info
|
|
~doc:
|
|
"make-compatible flags handling. Currently recognizes the -i and -j \
|
|
options and forwards them through to Ninja."
|
|
"MAKEFLAGS"
|
|
in
|
|
let makeflags =
|
|
Arg.(
|
|
value
|
|
& opt (some string) None
|
|
& info ["makeflags"] ~env ~docv:"FLAG"
|
|
~doc:
|
|
"Provides the contents of a $(i, MAKEFLAGS) variable to pass on \
|
|
to Ninja. Currently recognizes the -i and -j options.")
|
|
in
|
|
let makeflags_to_ninja_flags (makeflags : string option) =
|
|
match makeflags with
|
|
| None -> ["-k0"]
|
|
| Some makeflags ->
|
|
let ignore_rex = Re.(compile @@ word (char 'i')) in
|
|
let has_ignore = Re.execp ignore_rex makeflags in
|
|
let jobs_rex = Re.(compile @@ seq [str "-j"; group (rep digit)]) in
|
|
let number_of_jobs =
|
|
try ["-j" ^ Re.Group.get (Re.exec jobs_rex makeflags) 1]
|
|
with _ -> []
|
|
in
|
|
(if has_ignore then ["-k0"] else []) @ number_of_jobs
|
|
in
|
|
Term.(const makeflags_to_ninja_flags $ makeflags)
|
|
|
|
let info =
|
|
let doc =
|
|
"Build system for Catala, a specification language for tax and social \
|
|
benefits computation rules."
|
|
in
|
|
let man =
|
|
[
|
|
`S Manpage.s_description;
|
|
`P
|
|
"$(b,clerk) is a build system for Catala, a specification language \
|
|
for tax and social benefits computation rules";
|
|
`S Manpage.s_authors;
|
|
`P "Denis Merigoux <denis.merigoux@inria.fr>";
|
|
`P "Emile Rolley <emile.rolley@tuta.io>";
|
|
`P "Louis Gesbert <louis.gesbert@inria.fr>";
|
|
`S Manpage.s_examples;
|
|
`P "Typical usage:";
|
|
`Pre "clerk test file.catala_en";
|
|
`S Manpage.s_bugs;
|
|
`P
|
|
"Please file bug reports at \
|
|
https://github.com/CatalaLang/catala/issues";
|
|
]
|
|
in
|
|
let exits = Cmd.Exit.defaults @ [Cmd.Exit.info ~doc:"on error." 1] in
|
|
Cmd.info "clerk" ~version ~doc ~exits ~man
|
|
end
|
|
|
|
(** {1 System analysis} *)
|
|
|
|
(** Some functions that poll the surrounding systems (think [./configure]) *)
|
|
module Poll = struct
|
|
let project_root_absrel : (File.t option * File.t) Lazy.t =
|
|
lazy
|
|
(let open File in
|
|
let home = try Sys.getenv "HOME" with Not_found -> "" in
|
|
let rec lookup dir rel =
|
|
if
|
|
Sys.file_exists (dir / "catala.opam")
|
|
|| Sys.file_exists (dir / ".git")
|
|
|| Sys.file_exists (dir / "clerk.toml")
|
|
then Some dir, rel
|
|
else if dir = home then None, Filename.current_dir_name
|
|
else
|
|
let parent = Filename.dirname dir in
|
|
if parent = dir then None, Filename.current_dir_name
|
|
else lookup parent (rel / Filename.parent_dir_name)
|
|
in
|
|
lookup (Sys.getcwd ()) Filename.current_dir_name)
|
|
|
|
let project_root = lazy (fst (Lazy.force project_root_absrel))
|
|
let project_root_relative = lazy (snd (Lazy.force project_root_absrel))
|
|
|
|
(** Scans for a parent directory being the root of the Catala source repo *)
|
|
let catala_project_root : File.t option Lazy.t =
|
|
lazy
|
|
(match Lazy.force project_root with
|
|
| Some root
|
|
when Sys.file_exists File.(root / "catala.opam")
|
|
&& Sys.file_exists File.(root / "dune-project") ->
|
|
Some root
|
|
| _ -> None)
|
|
|
|
let exec_dir : File.t = Catala_utils.Cli.exec_dir
|
|
let clerk_exe : File.t Lazy.t = lazy (Unix.realpath Sys.executable_name)
|
|
|
|
let catala_exe : File.t Lazy.t =
|
|
lazy
|
|
(let f = File.(exec_dir / "catala") in
|
|
if Sys.file_exists f then Unix.realpath f
|
|
else
|
|
match Lazy.force project_root with
|
|
| Some root when Sys.file_exists File.(root / "catala.opam") ->
|
|
Unix.realpath
|
|
File.(root / "_build" / "default" / "compiler" / "catala.exe")
|
|
| _ -> File.check_exec "catala")
|
|
|
|
let build_dir : ?dir:File.t -> unit -> File.t =
|
|
fun ?(dir = "_build") () ->
|
|
let d = File.clean_path dir in
|
|
File.ensure_dir d;
|
|
d
|
|
(* Note: it could be safer here to use File.(Sys.getcwd () / "_build") by
|
|
default, but Ninja treats relative and absolute paths separately so that
|
|
you wouldn't then be able to build target _build/foo.ml but would have to
|
|
write the full path every time *)
|
|
|
|
(** Locates the main [lib] directory containing the OCaml libs *)
|
|
let ocaml_libdir : File.t Lazy.t =
|
|
lazy
|
|
(try String.trim (File.process_out "opam" ["var"; "lib"])
|
|
with Failure _ -> (
|
|
try String.trim (File.process_out "ocamlc" ["-where"])
|
|
with Failure _ -> (
|
|
match File.(check_directory (exec_dir /../ "lib")) with
|
|
| Some d -> d
|
|
| None ->
|
|
Message.error
|
|
"Could not locate the OCaml library directory, make sure OCaml \
|
|
or opam is installed")))
|
|
|
|
(** Locates the directory containing the OCaml runtime to link to *)
|
|
let ocaml_runtime_dir : File.t Lazy.t =
|
|
lazy
|
|
(let d =
|
|
match Lazy.force catala_project_root with
|
|
| Some root ->
|
|
(* Relative dir when running from catala source *)
|
|
File.(
|
|
root
|
|
/ "_build"
|
|
/ "install"
|
|
/ "default"
|
|
/ "lib"
|
|
/ "catala"
|
|
/ "runtime_ocaml")
|
|
| None -> (
|
|
match
|
|
File.check_directory
|
|
File.(exec_dir /../ "lib" / "catala" / "runtime_ocaml")
|
|
with
|
|
| Some d -> d
|
|
| None -> File.(Lazy.force ocaml_libdir / "catala" / "runtime_ocaml")
|
|
)
|
|
in
|
|
match File.check_directory d with
|
|
| Some dir ->
|
|
Message.debug "Catala runtime libraries found at @{<bold>%s@}." dir;
|
|
dir
|
|
| None ->
|
|
Message.error
|
|
"@[<hov>Could not locate the Catala runtime library at %s.@ Make \
|
|
sure that either catala is correctly installed,@ or you are \
|
|
running from the root of a compiled source tree.@]"
|
|
d)
|
|
|
|
let ocaml_include_and_lib_flags : (string list * string list) Lazy.t =
|
|
lazy
|
|
(let link_libs = ["zarith"; "dates_calc"] in
|
|
let includes_libs =
|
|
List.map
|
|
(fun lib ->
|
|
match File.(check_directory (Lazy.force ocaml_libdir / lib)) with
|
|
| None ->
|
|
Message.error
|
|
"Required OCaml library not found at %a.@ Try `opam install \
|
|
%s'"
|
|
File.format
|
|
File.(Lazy.force ocaml_libdir / lib)
|
|
lib
|
|
| Some d ->
|
|
( ["-I"; d],
|
|
String.map (function '-' -> '_' | c -> c) lib ^ ".cmxa" ))
|
|
link_libs
|
|
in
|
|
let includes, libs = List.split includes_libs in
|
|
( List.concat includes @ ["-I"; Lazy.force ocaml_runtime_dir],
|
|
libs @ [File.(Lazy.force ocaml_runtime_dir / "runtime_ocaml.cmxa")] ))
|
|
|
|
let ocaml_include_flags : string list Lazy.t =
|
|
lazy (fst (Lazy.force ocaml_include_and_lib_flags))
|
|
|
|
let ocaml_link_flags : string list Lazy.t =
|
|
lazy (snd (Lazy.force ocaml_include_and_lib_flags))
|
|
|
|
let has_command cmd =
|
|
let check_cmd = Printf.sprintf "type %s >/dev/null 2>&1" cmd in
|
|
Sys.command check_cmd = 0
|
|
|
|
let diff_command =
|
|
lazy
|
|
(if has_command "patdiff" then
|
|
["patdiff"; "-alt-old"; "reference"; "-alt-new"; "current-output"]
|
|
else
|
|
[
|
|
"diff";
|
|
"-u";
|
|
"-b";
|
|
"--color";
|
|
"--label";
|
|
"reference";
|
|
"--label";
|
|
"current-output";
|
|
])
|
|
end
|
|
|
|
(* Adjusts paths specified from the command-line relative to the user cwd to be
|
|
instead relative to the project root *)
|
|
let fix_path =
|
|
let from_dir = Sys.getcwd () in
|
|
fun d ->
|
|
let to_dir = Lazy.force Poll.project_root_relative in
|
|
Catala_utils.File.reverse_path ~from_dir ~to_dir d
|
|
|
|
(**{1 Building rules}*)
|
|
|
|
(** Ninja variable names *)
|
|
module Var = struct
|
|
include Nj.Var
|
|
|
|
(** Global vars: always defined, at toplevel *)
|
|
|
|
let ninja_required_version = make "ninja_required_version"
|
|
let builddir = make "builddir"
|
|
let clerk_exe = make "CLERK_EXE"
|
|
let catala_exe = make "CATALA_EXE"
|
|
let catala_flags = make "CATALA_FLAGS"
|
|
let catala_flags_ocaml = make "CATALA_FLAGS_OCAML"
|
|
let catala_flags_python = make "CATALA_FLAGS_PYTHON"
|
|
let clerk_flags = make "CLERK_FLAGS"
|
|
let ocamlc_exe = make "OCAMLC_EXE"
|
|
let ocamlopt_exe = make "OCAMLOPT_EXE"
|
|
let ocaml_flags = make "OCAML_FLAGS"
|
|
let runtime_ocaml_libs = make "RUNTIME_OCAML_LIBS"
|
|
let diff = make "DIFF"
|
|
let post_test = make "POST_TEST"
|
|
|
|
(** Rule vars, Used in specific rules *)
|
|
|
|
let input = make "in"
|
|
let output = make "out"
|
|
let pool = make "pool"
|
|
let src = make "src"
|
|
let orig_src = make "orig-src"
|
|
let scope = make "scope"
|
|
let test_id = make "test-id"
|
|
let test_command = make "test-command"
|
|
let ( ! ) = Var.v
|
|
end
|
|
|
|
let base_bindings catala_exe catala_flags build_dir include_dirs test_flags =
|
|
let includes =
|
|
List.fold_right
|
|
(fun dir flags ->
|
|
if Filename.is_relative dir then
|
|
"-I" :: File.(Var.(!builddir) / dir) :: flags
|
|
else "-I" :: dir :: flags)
|
|
include_dirs []
|
|
in
|
|
let catala_flags = ("--directory=" ^ Var.(!builddir)) :: catala_flags in
|
|
let catala_flags_ocaml =
|
|
List.filter
|
|
(function
|
|
| "--avoid-exceptions" | "-O" | "--optimize" -> true | _ -> false)
|
|
test_flags
|
|
in
|
|
let catala_flags_python =
|
|
List.filter
|
|
(function
|
|
| "--avoid-exceptions" | "-O" | "--optimize" | "--closure-conversion" ->
|
|
true
|
|
| _ -> false)
|
|
test_flags
|
|
in
|
|
let ocaml_flags = Lazy.force Poll.ocaml_include_flags in
|
|
[
|
|
Nj.binding Var.ninja_required_version ["1.7"];
|
|
(* use of implicit outputs *)
|
|
Nj.binding Var.builddir [build_dir];
|
|
Nj.binding Var.clerk_exe [Lazy.force Poll.clerk_exe];
|
|
Nj.binding Var.catala_exe
|
|
[
|
|
(match catala_exe with
|
|
| Some e -> File.check_exec e
|
|
| None -> Lazy.force Poll.catala_exe);
|
|
];
|
|
Nj.binding Var.catala_flags (catala_flags @ includes);
|
|
Nj.binding Var.catala_flags_ocaml catala_flags_ocaml;
|
|
Nj.binding Var.catala_flags_python catala_flags_python;
|
|
Nj.binding Var.clerk_flags
|
|
("-e"
|
|
:: Var.(!catala_exe)
|
|
:: ("--test-flags=" ^ String.concat "," test_flags)
|
|
:: includes
|
|
@ List.map (fun f -> "--catala-opts=" ^ f) catala_flags);
|
|
Nj.binding Var.ocamlc_exe ["ocamlc"];
|
|
Nj.binding Var.ocamlopt_exe ["ocamlopt"];
|
|
Nj.binding Var.ocaml_flags (ocaml_flags @ includes);
|
|
Nj.binding Var.runtime_ocaml_libs (Lazy.force Poll.ocaml_link_flags);
|
|
Nj.binding Var.diff (Lazy.force Poll.diff_command);
|
|
Nj.binding Var.post_test [Var.(!diff)];
|
|
]
|
|
|
|
let[@ocamlformat "disable"] static_base_rules =
|
|
let open Var in
|
|
let color = Message.has_color stdout in
|
|
let shellout l = Format.sprintf "$$(%s)" (String.concat " " l) in
|
|
[
|
|
Nj.rule "copy"
|
|
~command:["cp"; "-f"; !input; !output]
|
|
~description:["<copy>"; !input];
|
|
|
|
Nj.rule "catala-ocaml"
|
|
~command:[!catala_exe; "ocaml"; !catala_flags; !catala_flags_ocaml;
|
|
!input; "-o"; !output]
|
|
~description:["<catala>"; "ocaml"; "⇒"; !output];
|
|
|
|
Nj.rule "ocaml-object"
|
|
~command:[!ocamlc_exe; "-i"; !ocaml_flags; !input; ">"; !input^"i"; "&&";
|
|
!ocamlc_exe; "-opaque"; !ocaml_flags; !input^"i"; "&&";
|
|
!ocamlc_exe; "-c"; !ocaml_flags; !input; "&&";
|
|
!ocamlopt_exe; "-c"; "-intf-suffix"; ".ml"; !ocaml_flags; !input]
|
|
~description:["<ocaml>"; "⇒"; !output];
|
|
|
|
Nj.rule "ocaml-module"
|
|
~command:
|
|
[!ocamlopt_exe; "-shared"; !ocaml_flags; !input; "-o"; !output]
|
|
~description:["<ocaml>"; "⇒"; !output];
|
|
|
|
Nj.rule "ocaml-exec"
|
|
~command: [
|
|
!ocamlopt_exe; !ocaml_flags; !runtime_ocaml_libs;
|
|
shellout [!catala_exe; "depends";
|
|
"--prefix="^ !builddir; "--extension=cmx";
|
|
!catala_flags; !orig_src];
|
|
"-o"; !output;
|
|
]
|
|
~description:["<ocaml>"; "⇒"; !output];
|
|
|
|
Nj.rule "python"
|
|
~command:[!catala_exe; "python"; !catala_flags; !catala_flags_python;
|
|
!input; "-o"; !output]
|
|
~description:["<catala>"; "python"; "⇒"; !output];
|
|
|
|
Nj.rule "out-test"
|
|
~command: [
|
|
!catala_exe; !test_command; "--plugin-dir="; "-o -"; !catala_flags;
|
|
!input; "2>&1";
|
|
"|"; "sed";
|
|
"'s/\"CM0|[a-zA-Z0-9|]*\"/\"CMX|XXXXXXXX|XXXXXXXX|XXXXXXXX\"/g'";
|
|
">"; !output;
|
|
"||"; "true"
|
|
]
|
|
~description:
|
|
["<catala>"; "test"; !test_id; "⇐"; !input; "(" ^ !test_command ^ ")"];
|
|
|
|
Nj.rule "inline-tests"
|
|
~command:
|
|
[!clerk_exe; "runtest"; !clerk_flags; !input; ">"; !output; "2>&1";
|
|
"||"; "true"]
|
|
~description:["<catala>"; "inline-tests"; "⇐"; !input];
|
|
|
|
Nj.rule "post-test"
|
|
~command:[
|
|
!post_test; !input; ";";
|
|
"echo"; "-n"; "$$?"; ">"; !output;
|
|
]
|
|
~description:["<test>"; !test_id];
|
|
|
|
Nj.rule "interpret"
|
|
~command:
|
|
[!catala_exe; "interpret"; !catala_flags; !input; "--scope=" ^ !scope]
|
|
~description:["<catala>"; "interpret"; !scope; "⇐"; !input]
|
|
~vars:[pool, ["console"]];
|
|
|
|
Nj.rule "dir-tests"
|
|
~command:["cat"; !input; ">"; !output; ";"]
|
|
~description:["<test>"; !test_id];
|
|
|
|
Nj.rule "test-results"
|
|
~command:[
|
|
"out=" ^ !output; ";";
|
|
"success=$$("; "tr"; "-cd"; "0"; "<"; !input; "|"; "wc"; "-c"; ")"; ";";
|
|
"total=$$("; "wc"; "-c"; "<"; !input; ")"; ";";
|
|
"pass=$$("; ")"; ";";
|
|
"if"; "test"; "\"$$success\""; "-eq"; "\"$$total\""; ";"; "then";
|
|
"printf";
|
|
(if color then "\"\\n[\\033[32mPASS\\033[m] \\033[1m%s\\033[m: \
|
|
\\033[32m%3d\\033[m/\\033[32m%d\\033[m\\n\""
|
|
else "\"\\n[PASS] %s: %3d/%d\\n\"");
|
|
"$${out%@test}"; "$$success"; "$$total"; ";";
|
|
"else";
|
|
"printf";
|
|
(if color then "\"\\n[\\033[31mFAIL\\033[m] \\033[1m%s\\033[m: \
|
|
\\033[31m%3d\\033[m/\\033[32m%d\\033[m\\n\""
|
|
else "\"\\n[FAIL] %s: %3d/%d\\n\"");
|
|
"$${out%@test}"; "$$success"; "$$total"; ";";
|
|
"return"; "1"; ";";
|
|
"fi";
|
|
]
|
|
~description:["<test>"; !output];
|
|
(* Note: this last rule looks horrible, but the processing is pretty simple:
|
|
in the rules above, we output the returning code of diffing individual
|
|
tests to a [<testfile>@test] file, then the rules for directories just
|
|
concat these files. What this last rule does is then just count the number
|
|
of `0` and the total number of characters in the file, and print a readable
|
|
message. Instead of this disgusting shell code embedded in the ninja file,
|
|
this could be a specialised subcommand of clerk, e.g. `clerk
|
|
test-diagnostic <results-file@test>` *)
|
|
]
|
|
|
|
let gen_build_statements
|
|
(include_dirs : string list)
|
|
(same_dir_modules : (string * File.t) list)
|
|
(item : Scan.item) : Nj.ninja =
|
|
let open File in
|
|
let ( ! ) = Var.( ! ) in
|
|
let src = item.file_name in
|
|
let modules = List.rev item.used_modules in
|
|
let modfile ext modname =
|
|
match List.assoc_opt modname same_dir_modules with
|
|
| Some f -> (!Var.builddir / Filename.remove_extension f) ^ ext
|
|
| None -> modname ^ ext
|
|
in
|
|
let inc x = !Var.builddir / x in
|
|
let modd x = modfile "@module" x in
|
|
let def_src = Nj.binding Var.src [Filename.remove_extension src] in
|
|
let srcv = !Var.src ^ Filename.extension src in
|
|
let include_deps =
|
|
Nj.build "copy" ~inputs:[srcv]
|
|
~implicit_in:(List.map inc item.included_files @ List.map modd modules)
|
|
~outputs:[inc srcv]
|
|
in
|
|
let target_file ext = (!Var.builddir / !Var.src) ^ "." ^ ext in
|
|
let module_deps =
|
|
Option.map
|
|
(fun m ->
|
|
Nj.build "phony"
|
|
~inputs:[inc srcv; target_file "cmi"; target_file "cmxs"]
|
|
~outputs:[modd m])
|
|
item.module_def
|
|
in
|
|
let ml_file = target_file "ml" in
|
|
let py_file = target_file "py" in
|
|
let ocaml, python =
|
|
if item.extrnal then
|
|
( Nj.build "copy"
|
|
~implicit_in:[inc srcv]
|
|
~inputs:[src -.- "ml"]
|
|
~outputs:[ml_file],
|
|
Nj.build "copy"
|
|
~implicit_in:[inc srcv]
|
|
~inputs:[src -.- "py"]
|
|
~outputs:[py_file] )
|
|
else
|
|
( Nj.build "catala-ocaml"
|
|
~inputs:[inc srcv]
|
|
~implicit_in:[!Var.catala_exe] ~outputs:[ml_file],
|
|
Nj.build "python"
|
|
~inputs:[inc srcv]
|
|
~implicit_in:[!Var.catala_exe] ~outputs:[py_file] )
|
|
in
|
|
let ocamlopt =
|
|
let obj =
|
|
Nj.build "ocaml-object" ~inputs:[ml_file]
|
|
~implicit_in:(!Var.catala_exe :: List.map modd modules)
|
|
~outputs:(List.map target_file ["mli"; "cmi"; "cmo"; "cmx"; "cmt"; "o"])
|
|
~vars:
|
|
[
|
|
( Var.ocaml_flags,
|
|
!Var.ocaml_flags
|
|
:: "-I"
|
|
:: (!Var.builddir / src /../ "")
|
|
:: List.concat_map
|
|
(fun d ->
|
|
[
|
|
"-I";
|
|
(if Filename.is_relative d then !Var.builddir / d else d);
|
|
])
|
|
include_dirs );
|
|
]
|
|
in
|
|
let modexec =
|
|
match item.module_def with
|
|
| Some _ ->
|
|
Nj.build "ocaml-module"
|
|
~inputs:[target_file "cmx"]
|
|
~outputs:[target_file "cmxs"]
|
|
| None ->
|
|
Nj.build "ocaml-exec"
|
|
~inputs:[target_file "cmx"]
|
|
~outputs:[target_file "exe"]
|
|
~vars:[Var.orig_src, [inc srcv]]
|
|
in
|
|
[obj; modexec]
|
|
in
|
|
let expose_module =
|
|
match item.module_def with
|
|
| Some m when List.mem (dirname src) include_dirs ->
|
|
Some (Nj.build "phony" ~outputs:[m ^ "@module"] ~inputs:[modd m])
|
|
| _ -> None
|
|
in
|
|
let interp_deps =
|
|
!Var.catala_exe
|
|
:: List.map
|
|
(fun m ->
|
|
match List.assoc_opt m same_dir_modules with
|
|
| Some f -> (!Var.builddir / Filename.remove_extension f) ^ ".cmxs"
|
|
| None -> m ^ "@module")
|
|
modules
|
|
in
|
|
let interpret =
|
|
Nj.build "interpret"
|
|
~outputs:[srcv ^ "@interpret"]
|
|
~inputs:[inc srcv]
|
|
~implicit_in:interp_deps
|
|
in
|
|
let legacy_test_reference test =
|
|
(src /../ "output" / Filename.basename src) -.- test.Scan.id
|
|
in
|
|
let tests =
|
|
let legacy_tests =
|
|
List.fold_left
|
|
(fun acc test ->
|
|
let vars =
|
|
[Var.test_id, [test.Scan.id]; Var.test_command, test.Scan.cmd]
|
|
in
|
|
let reference = legacy_test_reference test in
|
|
let test_out =
|
|
(!Var.builddir / src /../ "output" / Filename.basename src)
|
|
-.- test.id
|
|
in
|
|
Nj.build "out-test"
|
|
~inputs:[inc srcv]
|
|
~implicit_in:interp_deps ~outputs:[test_out] ~vars
|
|
:: (* The test reference is an input because of the cases when we run
|
|
diff; it should actually be an output for the cases when we
|
|
reset but that shouldn't cause trouble. *)
|
|
Nj.build "post-test" ~inputs:[reference; test_out]
|
|
~implicit_in:["always"]
|
|
~outputs:[(!Var.builddir / reference) ^ "@post"]
|
|
~vars:[Var.test_id, [reference]]
|
|
:: acc)
|
|
[] item.legacy_tests
|
|
in
|
|
let inline_tests =
|
|
if not item.has_inline_tests then []
|
|
else
|
|
[
|
|
Nj.build "inline-tests"
|
|
~inputs:[inc srcv]
|
|
~implicit_in:(!Var.clerk_exe :: interp_deps)
|
|
~outputs:[(!Var.builddir / srcv) ^ "@out"];
|
|
]
|
|
in
|
|
let tests =
|
|
let results =
|
|
Nj.build "test-results"
|
|
~outputs:[srcv ^ "@test"]
|
|
~inputs:[inc (srcv ^ "@test")]
|
|
in
|
|
let inline_test label =
|
|
Nj.build "post-test"
|
|
~outputs:[inc (srcv ^ label)]
|
|
~inputs:[srcv; inc (srcv ^ "@out")]
|
|
~implicit_in:["always"]
|
|
~vars:[Var.test_id, [srcv]]
|
|
in
|
|
match item.legacy_tests with
|
|
| [] ->
|
|
if item.has_inline_tests then [inline_test "@test"; results] else []
|
|
| legacy ->
|
|
let inline =
|
|
if item.has_inline_tests then [inline_test "@inline"] else []
|
|
in
|
|
inline
|
|
@ [
|
|
Nj.build "dir-tests"
|
|
~outputs:[inc (srcv ^ "@test")]
|
|
~inputs:
|
|
((if item.has_inline_tests then [inc (srcv ^ "@inline")] else [])
|
|
@ List.map
|
|
(fun test ->
|
|
(!Var.builddir / legacy_test_reference test) ^ "@post")
|
|
legacy)
|
|
~vars:[Var.test_id, [srcv]];
|
|
results;
|
|
]
|
|
in
|
|
legacy_tests @ inline_tests @ tests
|
|
in
|
|
Seq.concat
|
|
@@ List.to_seq
|
|
[
|
|
Seq.return (Nj.comment "");
|
|
Seq.return def_src;
|
|
Seq.return include_deps;
|
|
Option.to_seq module_deps;
|
|
Option.to_seq expose_module;
|
|
Seq.return ocaml;
|
|
List.to_seq ocamlopt;
|
|
Seq.return python;
|
|
List.to_seq tests;
|
|
Seq.return interpret;
|
|
]
|
|
|
|
let gen_build_statements_dir
|
|
(include_dirs : string list)
|
|
(items : Scan.item list) : Nj.ninja =
|
|
let same_dir_modules =
|
|
List.filter_map
|
|
(fun item ->
|
|
Option.map (fun name -> name, item.Scan.file_name) item.Scan.module_def)
|
|
items
|
|
in
|
|
Seq.flat_map
|
|
(gen_build_statements include_dirs same_dir_modules)
|
|
(List.to_seq items)
|
|
|
|
let dir_test_rules dir subdirs items =
|
|
let open File in
|
|
let inputs =
|
|
List.rev_append
|
|
(List.rev_map (fun s -> (Var.(!builddir) / s) ^ "@test") subdirs)
|
|
(List.filter_map
|
|
(fun item ->
|
|
if item.Scan.legacy_tests = [] && not item.Scan.has_inline_tests then
|
|
None
|
|
else Some ((Var.(!builddir) / item.Scan.file_name) ^ "@test"))
|
|
items)
|
|
in
|
|
List.to_seq
|
|
[
|
|
Nj.Comment "";
|
|
Nj.build "dir-tests"
|
|
~outputs:[(Var.(!builddir) / dir) ^ "@test"]
|
|
~inputs
|
|
~vars:[Var.test_id, [dir]];
|
|
Nj.build "test-results"
|
|
~outputs:[dir ^ "@test"]
|
|
~inputs:[(Var.(!builddir) / dir) ^ "@test"];
|
|
]
|
|
|
|
let build_statements include_dirs dir =
|
|
Scan.tree dir
|
|
|> Seq.flat_map
|
|
@@ fun (dir, subdirs, items) ->
|
|
Seq.append
|
|
(gen_build_statements_dir include_dirs items)
|
|
(dir_test_rules dir subdirs items)
|
|
|
|
let gen_ninja_file catala_exe catala_flags build_dir include_dirs test_flags dir
|
|
=
|
|
let build_dir =
|
|
match test_flags with
|
|
| [] -> build_dir
|
|
| flags -> File.((build_dir / "test") ^ String.concat "" flags)
|
|
in
|
|
let ( @+ ) = Seq.append in
|
|
Seq.return
|
|
(Nj.Comment (Printf.sprintf "File generated by Clerk v.%s\n" version))
|
|
@+ Seq.return (Nj.Comment "- Global variables - #\n")
|
|
@+ List.to_seq
|
|
(base_bindings catala_exe catala_flags build_dir include_dirs test_flags)
|
|
@+ Seq.return (Nj.Comment "\n- Base rules - #\n")
|
|
@+ List.to_seq static_base_rules
|
|
@+ Seq.return (Nj.build "phony" ~outputs:["always"])
|
|
@+ Seq.return (Nj.Comment "\n- Project-specific build statements - #")
|
|
@+ build_statements include_dirs dir
|
|
@+ Seq.return (Nj.build "phony" ~outputs:["test"] ~inputs:[".@test"])
|
|
|
|
(** {1 Driver} *)
|
|
|
|
let ninja_init
|
|
~chdir
|
|
~catala_exe
|
|
~catala_opts
|
|
~build_dir
|
|
~include_dirs
|
|
~color
|
|
~debug
|
|
~ninja_output :
|
|
extra:def Seq.t -> test_flags:string list -> (File.t -> 'a) -> 'a =
|
|
let _options = Catala_utils.Global.enforce_options ~debug ~color () in
|
|
let chdir =
|
|
match chdir with None -> Lazy.force Poll.project_root | some -> some
|
|
in
|
|
Option.iter Sys.chdir chdir;
|
|
let build_dir = Poll.build_dir ?dir:build_dir () in
|
|
let with_ninja_output k =
|
|
match ninja_output with
|
|
| Some f -> k f
|
|
| None when debug -> k File.(build_dir / "clerk.ninja")
|
|
| None -> File.with_temp_file "clerk_build_" ".ninja" k
|
|
in
|
|
fun ~extra ~test_flags k ->
|
|
Message.debug "building ninja rules...";
|
|
with_ninja_output
|
|
@@ fun nin_file ->
|
|
File.with_formatter_of_file nin_file (fun nin_ppf ->
|
|
let ninja_contents =
|
|
Seq.concat
|
|
@@ List.to_seq
|
|
[
|
|
gen_ninja_file catala_exe catala_opts build_dir include_dirs
|
|
test_flags ".";
|
|
Seq.return (Nj.comment "\n - Command-specific targets - #");
|
|
extra;
|
|
]
|
|
in
|
|
Nj.format nin_ppf ninja_contents);
|
|
k nin_file
|
|
|
|
let cleaned_up_env () =
|
|
let passthrough_vars =
|
|
["CATALA_BIN="; "CATALA_INCLUDE="; "CATALA_TEST_FLAGS="]
|
|
in
|
|
Unix.environment ()
|
|
|> Array.to_seq
|
|
|> Seq.filter (fun s ->
|
|
(not (String.starts_with ~prefix:"CATALA_" s))
|
|
|| List.exists
|
|
(fun prefix -> String.starts_with ~prefix s)
|
|
passthrough_vars
|
|
||
|
|
(Message.warning "Ignoring environment variable %s" s;
|
|
false))
|
|
|> Array.of_seq
|
|
|
|
let ninja_cmdline ninja_flags nin_file targets =
|
|
("ninja" :: "-f" :: nin_file :: ninja_flags)
|
|
@ (if Catala_utils.Global.options.debug then ["-v"] else [])
|
|
@ targets
|
|
|
|
let run_ninja ~clean_up_env cmdline =
|
|
let cmd = List.hd cmdline in
|
|
let env = if clean_up_env then cleaned_up_env () else Unix.environment () in
|
|
let npid =
|
|
Unix.create_process_env cmd (Array.of_list cmdline) env Unix.stdin
|
|
Unix.stdout Unix.stderr
|
|
in
|
|
let return_code =
|
|
match Unix.waitpid [] npid with
|
|
| _, Unix.WEXITED n -> n
|
|
| _, (Unix.WSIGNALED n | Unix.WSTOPPED n) -> 128 - n
|
|
in
|
|
raise (Catala_utils.Cli.Exit_with return_code)
|
|
|
|
open Cmdliner
|
|
|
|
let build_cmd =
|
|
let run ninja_init (targets : string list) (ninja_flags : string list) =
|
|
ninja_init ~extra:Seq.empty ~test_flags:[]
|
|
@@ fun nin_file ->
|
|
let targets =
|
|
List.map
|
|
(fun f ->
|
|
if String.exists (function '/' | '.' -> true | _ -> false) f then
|
|
fix_path f
|
|
else f)
|
|
targets
|
|
in
|
|
let ninja_cmd = ninja_cmdline ninja_flags nin_file targets in
|
|
Message.debug "executing '%s'..." (String.concat " " ninja_cmd);
|
|
run_ninja ~clean_up_env:false ninja_cmd
|
|
in
|
|
let doc =
|
|
"Low-level build command: can be used to forward build targets or options \
|
|
directly to Ninja"
|
|
in
|
|
Cmd.v (Cmd.info ~doc "build")
|
|
Term.(
|
|
const run $ Cli.Global.term ninja_init $ Cli.targets $ Cli.ninja_flags)
|
|
|
|
let test_cmd =
|
|
let run
|
|
ninja_init
|
|
(files_or_folders : string list)
|
|
(reset_test_outputs : bool)
|
|
(test_flags : string list)
|
|
(ninja_flags : string list) =
|
|
let targets =
|
|
let fs = if files_or_folders = [] then ["."] else files_or_folders in
|
|
List.map (fun f -> fix_path f ^ "@test") fs
|
|
in
|
|
let extra =
|
|
List.to_seq
|
|
((if reset_test_outputs then
|
|
[
|
|
Nj.binding Var.post_test
|
|
[
|
|
"test_reset() { if ! diff -q $$1 $$2 >/dev/null; then cp -f \
|
|
$$2 $$1; fi; }";
|
|
";";
|
|
"test_reset";
|
|
];
|
|
]
|
|
else [])
|
|
@ [Nj.default targets])
|
|
in
|
|
ninja_init ~extra ~test_flags
|
|
@@ fun nin_file ->
|
|
let ninja_cmd = ninja_cmdline ninja_flags nin_file targets in
|
|
Message.debug "executing '%s'..." (String.concat " " ninja_cmd);
|
|
run_ninja ~clean_up_env:true ninja_cmd
|
|
in
|
|
let doc =
|
|
"Scan the given files or directories for catala tests, build their \
|
|
requirement and run them all. With $(b,--reset) the expected results are \
|
|
updated in-place ; otherwise, 0 is returned if the output matches the \
|
|
reference, or 1 is returned and a diff is printed to stdout"
|
|
in
|
|
Cmd.v (Cmd.info ~doc "test")
|
|
Term.(
|
|
const run
|
|
$ Cli.Global.term ninja_init
|
|
$ Cli.files_or_folders
|
|
$ Cli.reset_test_outputs
|
|
$ Cli.test_flags
|
|
$ Cli.ninja_flags)
|
|
|
|
let run_cmd =
|
|
let run
|
|
ninja_init
|
|
(files_or_folders : string list)
|
|
(scope : string)
|
|
(ninja_flags : string list) =
|
|
let extra =
|
|
Seq.cons
|
|
(Nj.binding Var.scope [scope])
|
|
(Seq.return
|
|
(Nj.default
|
|
(List.map (fun file -> file ^ "@interpret") files_or_folders)))
|
|
in
|
|
ninja_init ~extra ~test_flags:[]
|
|
@@ fun nin_file ->
|
|
let ninja_cmd = ninja_cmdline ninja_flags nin_file [] in
|
|
Message.debug "executing '%s'..." (String.concat " " ninja_cmd);
|
|
run_ninja ~clean_up_env:false ninja_cmd
|
|
in
|
|
let doc =
|
|
"Runs the Catala interpreter on the given files, after building their \
|
|
dependencies. The scope to be executed must be specified using the \
|
|
$(i,-s) option."
|
|
in
|
|
Cmd.v (Cmd.info ~doc "run")
|
|
Term.(
|
|
const run
|
|
$ Cli.Global.term ninja_init
|
|
$ Cli.files_or_folders
|
|
$ Cli.scope
|
|
$ Cli.ninja_flags)
|
|
|
|
let runtest_cmd =
|
|
let run catala_exe catala_opts include_dirs test_flags file =
|
|
let catala_opts =
|
|
List.fold_left
|
|
(fun opts dir -> "-I" :: dir :: opts)
|
|
catala_opts include_dirs
|
|
in
|
|
Clerk_runtest.run_inline_tests
|
|
(Option.value ~default:"catala" catala_exe)
|
|
catala_opts test_flags file;
|
|
0
|
|
in
|
|
let doc =
|
|
"Mainly for internal purposes. Runs inline tests from a Catala file, and \
|
|
outputs their results to stdout"
|
|
in
|
|
Cmd.v (Cmd.info ~doc "runtest")
|
|
Term.(
|
|
const run
|
|
$ Cli.catala_exe
|
|
$ Cli.catala_opts
|
|
$ Cli.include_dirs
|
|
$ Cli.test_flags
|
|
$ Cli.single_file)
|
|
|
|
let main_cmd = Cmd.group Cli.info [build_cmd; test_cmd; run_cmd; runtest_cmd]
|
|
|
|
let main () =
|
|
try exit (Cmdliner.Cmd.eval' ~catch:false main_cmd) with
|
|
| Catala_utils.Cli.Exit_with n -> exit n
|
|
| Message.CompilerError content ->
|
|
let bt = Printexc.get_raw_backtrace () in
|
|
Message.Content.emit content Error;
|
|
if Catala_utils.Global.options.debug then
|
|
Printexc.print_raw_backtrace stderr bt;
|
|
exit Cmd.Exit.some_error
|
|
| Sys_error msg ->
|
|
let bt = Printexc.get_raw_backtrace () in
|
|
Message.Content.emit
|
|
(Message.Content.of_string ("System error: " ^ msg))
|
|
Error;
|
|
if Printexc.backtrace_status () then Printexc.print_raw_backtrace stderr bt;
|
|
exit Cmd.Exit.internal_error
|
|
| e ->
|
|
let bt = Printexc.get_raw_backtrace () in
|
|
Message.Content.emit
|
|
(Message.Content.of_string ("Unexpected error: " ^ Printexc.to_string e))
|
|
Error;
|
|
if Printexc.backtrace_status () then Printexc.print_raw_backtrace stderr bt;
|
|
exit Cmd.Exit.internal_error
|