mirror of
https://github.com/CatalaLang/catala.git
synced 2024-11-08 07:51:43 +03:00
build(clerk/opam): add a clerk opam package and a clerk.driver library to test
This commit is contained in:
parent
73576548c6
commit
f4ab6f5a96
@ -12,640 +12,4 @@
|
||||
or implied. See the License for the specific language governing permissions and limitations under
|
||||
the License. *)
|
||||
|
||||
open Cmdliner
|
||||
open Utils
|
||||
open Ninja_utils
|
||||
module Nj = Ninja_utils
|
||||
|
||||
(** {1 Command line interface} *)
|
||||
|
||||
let files_or_folders =
|
||||
Arg.(
|
||||
non_empty & pos_right 0 file [] & info [] ~docv:"FILE(S)" ~doc:"File(s) or folder(s) to process")
|
||||
|
||||
let command =
|
||||
Arg.(
|
||||
required
|
||||
& pos 0 (some string) None
|
||||
& info [] ~docv:"COMMAND" ~doc:"Command selection among: test, run")
|
||||
|
||||
let debug = Arg.(value & flag & info [ "debug"; "d" ] ~doc:"Prints debug information")
|
||||
|
||||
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 catalac =
|
||||
Arg.(
|
||||
value
|
||||
& opt (some string) None
|
||||
& info [ "e"; "exe" ] ~docv:"EXE" ~doc:"Catala compiler executable, defaults to `catala`")
|
||||
|
||||
let ninja_output =
|
||||
Arg.(
|
||||
value
|
||||
& opt (some file) None
|
||||
& info [ "o"; "output" ] ~docv:"OUTPUT"
|
||||
~doc:
|
||||
"$(i, OUTPUT) is the file that will contain the build.ninja file output. If not \
|
||||
specified, the build.ninja file will be outputed in the temporary directory of the \
|
||||
system.")
|
||||
|
||||
let scope =
|
||||
Arg.(
|
||||
value
|
||||
& 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 catala_opts =
|
||||
Arg.(
|
||||
value
|
||||
& opt (some string) None
|
||||
& info [ "c"; "catala-opts" ] ~docv:"LANG" ~doc:"Options to pass to the Catala compiler")
|
||||
|
||||
let clerk_t f =
|
||||
Term.(
|
||||
const f $ files_or_folders $ command $ catalac $ catala_opts $ debug $ scope
|
||||
$ reset_test_outputs $ ninja_output)
|
||||
|
||||
let version = "0.5.0"
|
||||
|
||||
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_commands;
|
||||
`I
|
||||
( "test",
|
||||
"Tests a Catala source file given expected outputs provided in a directory called \
|
||||
`output` at the same level that the tested file. If the tested file is `foo.catala_en`, \
|
||||
then `output` should contain expected output files like `foo.catala_en.$(i,BACKEND)` \
|
||||
where $(i,BACKEND) is chosen among: `Interpret`, `Dcalc`, `Scalc`, `Lcalc`, \
|
||||
`Typecheck, `Scopelang`, `html`, `tex`, `py`, `ml` and `d` (for Makefile dependencies). \
|
||||
For the `Interpret` backend, the scope to test is selected by naming the expected \
|
||||
output file `foo.catala_en.$(i,SCOPE).interpret`. When the argument of $(b,clerk) is a \
|
||||
folder, it recursively looks for Catala files coupled with `output` directories and \
|
||||
matching expected output on which to perform tests." );
|
||||
`I
|
||||
("run", "Runs the Catala interpreter on a given scope of a given file. See the `-s` option.");
|
||||
`S Manpage.s_authors;
|
||||
`P "Denis Merigoux <denis.merigoux@inria.fr>";
|
||||
`P "Emile Rolley <emile.rolley@tuta.io>";
|
||||
`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 = Term.default_exits @ [ Term.exit_info ~doc:"on error." 1 ] in
|
||||
Term.info "clerk" ~version ~doc ~exits ~man
|
||||
|
||||
(**{1 Testing}*)
|
||||
|
||||
let catala_backend_to_string (backend : Cli.backend_option) : string =
|
||||
match backend with
|
||||
| Cli.Dcalc -> "Dcalc"
|
||||
| Cli.Html -> "Html"
|
||||
| Cli.Interpret -> "Interpret"
|
||||
| Cli.Latex -> "Latex"
|
||||
| Cli.Lcalc -> "Lcalc"
|
||||
| Cli.Makefile -> "Makefile"
|
||||
| Cli.OCaml -> "OCaml"
|
||||
| Cli.Proof -> "Proof"
|
||||
| Cli.Python -> "Python"
|
||||
| Cli.Scalc -> "Scalc"
|
||||
| Cli.Scopelang -> "Scopelang"
|
||||
| Cli.Typecheck -> "Typecheck"
|
||||
|
||||
type expected_output_descr = {
|
||||
base_filename : string;
|
||||
output_dir : string;
|
||||
complete_filename : string;
|
||||
backend : Cli.backend_option;
|
||||
scope : string option;
|
||||
}
|
||||
|
||||
let catala_suffix_regex = Re.Pcre.regexp "\\.catala_(\\w){2}"
|
||||
|
||||
let filename_to_expected_output_descr (output_dir : string) (filename : string) :
|
||||
expected_output_descr option =
|
||||
let complete_filename = filename in
|
||||
let first_extension = Filename.extension filename in
|
||||
let filename = Filename.remove_extension filename in
|
||||
let backend =
|
||||
match String.lowercase_ascii first_extension with
|
||||
| ".dcalc" -> Some Cli.Dcalc
|
||||
| ".d" -> Some Cli.Makefile
|
||||
| ".html" -> Some Cli.Html
|
||||
| ".interpret" -> Some Cli.Interpret
|
||||
| ".lcalc" -> Some Cli.Lcalc
|
||||
| ".ml" -> Some Cli.OCaml
|
||||
| ".proof" -> Some Cli.Proof
|
||||
| ".py" -> Some Cli.Python
|
||||
| ".scalc" -> Some Cli.Scalc
|
||||
| ".scopelang" -> Some Cli.Scopelang
|
||||
| ".tex" -> Some Cli.Latex
|
||||
| ".typecheck" -> Some Cli.Typecheck
|
||||
| _ -> None
|
||||
in
|
||||
match backend with
|
||||
| None -> None
|
||||
| Some backend ->
|
||||
let second_extension = Filename.extension filename in
|
||||
let base_filename, scope =
|
||||
if Re.Pcre.pmatch ~rex:catala_suffix_regex second_extension then (filename, None)
|
||||
else
|
||||
let scope_name_regex = Re.Pcre.regexp "\\.(.+)" in
|
||||
let scope_name = (Re.Pcre.extract ~rex:scope_name_regex second_extension).(1) in
|
||||
(Filename.remove_extension filename, Some scope_name)
|
||||
in
|
||||
Some { output_dir; complete_filename; base_filename; backend; scope }
|
||||
|
||||
(** Given a file, looks in the relative [output] directory if there are files with the same base
|
||||
name that contain expected outputs for different *)
|
||||
let search_for_expected_outputs (file : string) : expected_output_descr list =
|
||||
let output_dir = Filename.dirname file ^ Filename.dir_sep ^ "output/" in
|
||||
let output_files = try Sys.readdir output_dir with Sys_error _ -> Array.make 0 "" in
|
||||
List.filter_map
|
||||
(fun output_file ->
|
||||
match filename_to_expected_output_descr output_dir output_file with
|
||||
| None -> None
|
||||
| Some expected_output ->
|
||||
if expected_output.base_filename = Filename.basename file then Some expected_output
|
||||
else None)
|
||||
(Array.to_list output_files)
|
||||
|
||||
type testing_result = { error_code : int; number_of_tests_run : int; number_correct : int }
|
||||
|
||||
let add_reset_rules_aux ~(redirect : string) ~(with_scope_output_rule : string)
|
||||
~(without_scope_output_rule : string) (catala_exe_opts : string) (rules : Rule.t Nj.RuleMap.t) :
|
||||
Rule.t Nj.RuleMap.t =
|
||||
let reset_common_cmd_exprs =
|
||||
Nj.Expr.
|
||||
[
|
||||
Var "catala_cmd";
|
||||
Var "tested_file";
|
||||
Var "extra_flags";
|
||||
Lit "--unstyled";
|
||||
Lit redirect;
|
||||
Var "expected_output";
|
||||
Lit "2>&1";
|
||||
]
|
||||
in
|
||||
let reset_with_scope_rule =
|
||||
Nj.Rule.make with_scope_output_rule
|
||||
~command:
|
||||
Nj.Expr.(Seq ([ Lit catala_exe_opts; Lit "-s"; Var "scope" ] @ reset_common_cmd_exprs))
|
||||
~description:
|
||||
Nj.Expr.(
|
||||
Seq
|
||||
[
|
||||
Lit "RESET scope";
|
||||
Var "scope";
|
||||
Lit "of file";
|
||||
Var "tested_file";
|
||||
Lit "with the";
|
||||
Var "catala_cmd";
|
||||
Lit "command";
|
||||
])
|
||||
in
|
||||
let reset_without_scope_rule =
|
||||
Nj.Rule.make without_scope_output_rule
|
||||
~command:Nj.Expr.(Seq (Lit catala_exe_opts :: reset_common_cmd_exprs))
|
||||
~description:
|
||||
Nj.Expr.(
|
||||
Seq
|
||||
[
|
||||
Lit "RESET";
|
||||
Lit "file";
|
||||
Var "tested_file";
|
||||
Lit "with the";
|
||||
Var "catala_cmd";
|
||||
Lit "command";
|
||||
])
|
||||
in
|
||||
Nj.RuleMap.(
|
||||
rules
|
||||
|> add reset_with_scope_rule.name reset_with_scope_rule
|
||||
|> add reset_without_scope_rule.name reset_without_scope_rule)
|
||||
|
||||
let add_test_rules_aux ~(test_common_cmd_exprs : Expr.t list) ~(with_scope_output_rule : string)
|
||||
~(without_scope_output_rule : string) (catala_exe_opts : string) (rules : Rule.t Nj.RuleMap.t) :
|
||||
Rule.t Nj.RuleMap.t =
|
||||
let test_with_scope_rule =
|
||||
Nj.Rule.make with_scope_output_rule
|
||||
~command:
|
||||
Nj.Expr.(Seq ([ Lit catala_exe_opts; Lit "-s"; Var "scope" ] @ test_common_cmd_exprs))
|
||||
~description:
|
||||
Nj.Expr.(
|
||||
Seq
|
||||
[
|
||||
Lit "TEST scope";
|
||||
Var "scope";
|
||||
Lit "of file";
|
||||
Var "tested_file";
|
||||
Lit "with the";
|
||||
Var "catala_cmd";
|
||||
Lit "command";
|
||||
])
|
||||
in
|
||||
let test_without_scope_rule =
|
||||
Nj.Rule.make without_scope_output_rule
|
||||
~command:Nj.Expr.(Seq (Lit catala_exe_opts :: test_common_cmd_exprs))
|
||||
~description:
|
||||
Nj.Expr.(
|
||||
Seq
|
||||
[
|
||||
Lit "TEST on file"; Var "tested_file"; Lit "with the"; Var "catala_cmd"; Lit "command";
|
||||
])
|
||||
in
|
||||
Nj.RuleMap.(
|
||||
rules
|
||||
|> add test_with_scope_rule.name test_with_scope_rule
|
||||
|> add test_without_scope_rule.name test_without_scope_rule)
|
||||
|
||||
(** [add_reset_rules catala_exe_opts rules] adds ninja rules used to reset test files into [rules]
|
||||
and returns it.*)
|
||||
let add_reset_rules (catala_exe_opts : string) (rules : Rule.t Nj.RuleMap.t) : Rule.t Nj.RuleMap.t =
|
||||
add_reset_rules_aux ~with_scope_output_rule:"reset_with_scope"
|
||||
~without_scope_output_rule:"reset_without_scope" ~redirect:">" catala_exe_opts rules
|
||||
|
||||
(** [add_test_rules catala_exe_opts rules] adds ninja rules used to test files into [rules] and
|
||||
returns it.*)
|
||||
let add_test_rules (catala_exe_opts : string) (rules : Rule.t Nj.RuleMap.t) : Rule.t Nj.RuleMap.t =
|
||||
let test_common_cmd_exprs =
|
||||
Nj.Expr.
|
||||
[
|
||||
Var "catala_cmd";
|
||||
Var "tested_file";
|
||||
Var "extra_flags";
|
||||
Lit "--unstyled";
|
||||
Lit "2>&1 | colordiff -u -b";
|
||||
Var "expected_output";
|
||||
Lit "-";
|
||||
]
|
||||
in
|
||||
add_test_rules_aux ~test_common_cmd_exprs ~with_scope_output_rule:"test_with_scope"
|
||||
~without_scope_output_rule:"test_without_scope" catala_exe_opts rules
|
||||
|
||||
(** [add_reset_with_ouput_rules catala_exe_opts rules] adds ninja rules used to reset test files
|
||||
using an output flag into [rules] and returns it.*)
|
||||
let add_reset_with_output_rules (catala_exe_opts : string) (rules : Rule.t Nj.RuleMap.t) :
|
||||
Rule.t Nj.RuleMap.t =
|
||||
add_reset_rules_aux ~with_scope_output_rule:"reset_with_scope_and_output"
|
||||
~without_scope_output_rule:"reset_without_scope_and_output" ~redirect:"-o" catala_exe_opts rules
|
||||
|
||||
(** [add_test_with_output_rules catala_exe_opts rules] adds ninja rules used to test files using an
|
||||
output flag into [rules] and returns it.*)
|
||||
let add_test_with_output_rules (catala_exe_opts : string) (rules : Rule.t Nj.RuleMap.t) :
|
||||
Rule.t Nj.RuleMap.t =
|
||||
let test_common_cmd_exprs =
|
||||
Nj.Expr.
|
||||
[
|
||||
Var "catala_cmd";
|
||||
Var "tested_file";
|
||||
Var "extra_flags";
|
||||
Lit "--unstyled";
|
||||
Lit "-o";
|
||||
Var "tmp_file";
|
||||
Lit "; colordiff -u -b";
|
||||
Var "expected_output";
|
||||
Var "tmp_file";
|
||||
]
|
||||
in
|
||||
add_test_rules_aux ~test_common_cmd_exprs ~with_scope_output_rule:"test_with_scope_and_output"
|
||||
~without_scope_output_rule:"test_without_scope_and_output" catala_exe_opts rules
|
||||
|
||||
(** [ninja_start catala_exe] returns the inital [ninja] data structure with rules needed to reset
|
||||
and test files. *)
|
||||
let ninja_start (catala_exe : string) (catala_opts : string) : ninja =
|
||||
let catala_exe_opts = catala_exe ^ " " ^ catala_opts in
|
||||
let run_and_display_final_message =
|
||||
Nj.Rule.make "run_and_display_final_message"
|
||||
~command:Nj.Expr.(Seq [ Lit ":" ])
|
||||
~description:Nj.Expr.(Seq [ Lit "All tests"; Var "test_file_or_folder"; Lit "passed!" ])
|
||||
in
|
||||
{
|
||||
rules =
|
||||
Nj.RuleMap.(
|
||||
empty |> add_reset_rules catala_exe_opts |> add_test_rules catala_exe_opts
|
||||
|> add_test_with_output_rules catala_exe_opts
|
||||
|> add_reset_with_output_rules catala_exe_opts
|
||||
|> add run_and_display_final_message.name run_and_display_final_message);
|
||||
builds = Nj.BuildMap.empty;
|
||||
}
|
||||
|
||||
(** [collect_all_ninja_build ninja tested_file catala_exe catala_opts reset_test_outputs] creates
|
||||
and returns all ninja build statements needed to test the [tested_file]. *)
|
||||
let collect_all_ninja_build (ninja : ninja) (tested_file : string) (reset_test_outputs : bool) :
|
||||
(string * ninja) option =
|
||||
let expected_outputs = search_for_expected_outputs tested_file in
|
||||
if List.length expected_outputs = 0 then (
|
||||
Cli.debug_print (Format.asprintf "No expected outputs were found for test file %s" tested_file);
|
||||
None)
|
||||
else
|
||||
let ninja, test_names =
|
||||
List.fold_left
|
||||
(fun (ninja, test_names) expected_output ->
|
||||
let vars =
|
||||
[
|
||||
("catala_cmd", Nj.Expr.Lit (catala_backend_to_string expected_output.backend));
|
||||
("tested_file", Nj.Expr.Lit tested_file);
|
||||
( "expected_output",
|
||||
Nj.Expr.Lit (expected_output.output_dir ^ expected_output.complete_filename) );
|
||||
]
|
||||
in
|
||||
let output_build_kind = if reset_test_outputs then "reset" else "test" in
|
||||
let catala_backend = catala_backend_to_string expected_output.backend in
|
||||
|
||||
let get_rule_infos ?(rule_postfix = "") :
|
||||
string option -> string * string * (string * Nj.Expr.t) list = function
|
||||
| Some scope ->
|
||||
( Printf.sprintf "%s_%s_%s_%s" output_build_kind scope catala_backend tested_file
|
||||
|> Nj.Build.unpath,
|
||||
output_build_kind ^ "_with_scope" ^ rule_postfix,
|
||||
("scope", Nj.Expr.Lit scope) :: vars )
|
||||
| None ->
|
||||
( Printf.sprintf "%s_%s_%s" output_build_kind catala_backend tested_file
|
||||
|> Nj.Build.unpath,
|
||||
output_build_kind ^ "_without_scope" ^ rule_postfix,
|
||||
vars )
|
||||
in
|
||||
|
||||
let ninja_add_new_rule (rule_output : string) (rule : string)
|
||||
(vars : (string * Nj.Expr.t) list) (ninja : ninja) : ninja =
|
||||
{
|
||||
ninja with
|
||||
builds =
|
||||
Nj.BuildMap.add rule_output
|
||||
(Nj.Build.make_with_vars ~outputs:[ Nj.Expr.Lit rule_output ] ~rule ~vars)
|
||||
ninja.builds;
|
||||
}
|
||||
in
|
||||
|
||||
match expected_output.backend with
|
||||
| Cli.Interpret | Cli.Proof | Cli.Typecheck | Cli.Dcalc | Cli.Scopelang | Cli.Scalc
|
||||
| Cli.Lcalc ->
|
||||
let rule_output, rule_name, rule_vars = get_rule_infos expected_output.scope in
|
||||
let rule_vars =
|
||||
match expected_output.backend with
|
||||
| Cli.Proof ->
|
||||
("extra_flags", Nj.Expr.Lit "--disable_counterexamples") :: rule_vars
|
||||
(* Counterexamples can be different at each call because of the randomness
|
||||
inside SMT solver, so we can't expect their value to remain constant. Hence
|
||||
we disable the counterexamples when testing the replication of failed
|
||||
proofs. *)
|
||||
| _ -> rule_vars
|
||||
in
|
||||
( ninja_add_new_rule rule_output rule_name rule_vars ninja,
|
||||
test_names ^ " $\n " ^ rule_output )
|
||||
| Cli.Python | Cli.OCaml | Cli.Latex | Cli.Html | Cli.Makefile ->
|
||||
let tmp_file = Filename.temp_file "clerk_" ("_" ^ catala_backend) in
|
||||
let rule_output, rule_name, rule_vars =
|
||||
get_rule_infos ~rule_postfix:"_and_output" expected_output.scope
|
||||
in
|
||||
let rule_vars = ("tmp_file", Nj.Expr.Lit tmp_file) :: rule_vars in
|
||||
( ninja_add_new_rule rule_output rule_name rule_vars ninja,
|
||||
test_names ^ " $\n " ^ rule_output ))
|
||||
(ninja, "") expected_outputs
|
||||
in
|
||||
let test_name =
|
||||
tested_file
|
||||
|> (if reset_test_outputs then Printf.sprintf "reset_file_%s"
|
||||
else Printf.sprintf "test_file_%s")
|
||||
|> Nj.Build.unpath
|
||||
in
|
||||
Some
|
||||
( test_name,
|
||||
{
|
||||
ninja with
|
||||
builds =
|
||||
Nj.BuildMap.add test_name
|
||||
(Nj.Build.make_with_inputs ~outputs:[ Nj.Expr.Lit test_name ] ~rule:"phony"
|
||||
~inputs:[ Nj.Expr.Lit test_names ])
|
||||
ninja.builds;
|
||||
} )
|
||||
|
||||
(** [add_root_test_build ninja all_file_names all_test_builds] add the 'test' ninja build
|
||||
declaration calling the rule 'run_and_display_final_message' for [all_test_builds] which
|
||||
correspond to [all_file_names]. *)
|
||||
let add_root_test_build (ninja : ninja) (all_file_names : string list) (all_test_builds : string) :
|
||||
ninja =
|
||||
let file_names_str =
|
||||
List.hd all_file_names ^ ""
|
||||
^ List.fold_left (fun acc name -> acc ^ "; " ^ name) "" (List.tl all_file_names)
|
||||
in
|
||||
{
|
||||
ninja with
|
||||
builds =
|
||||
Nj.BuildMap.add "test"
|
||||
(Nj.Build.make_with_vars_and_inputs ~outputs:[ Nj.Expr.Lit "test" ]
|
||||
~rule:"run_and_display_final_message" ~inputs:[ Nj.Expr.Lit all_test_builds ]
|
||||
~vars:[ ("test_file_or_folder", Nj.Expr.Lit ("in [ " ^ file_names_str ^ " ]")) ])
|
||||
ninja.builds;
|
||||
}
|
||||
|
||||
(**{1 Running}*)
|
||||
|
||||
let run_file (file : string) (catala_exe : string) (catala_opts : string) (scope : string) : int =
|
||||
let command =
|
||||
String.concat " "
|
||||
(List.filter (fun s -> s <> "") [ catala_exe; catala_opts; "-s " ^ scope; "Interpret"; file ])
|
||||
in
|
||||
Cli.debug_print ("Running: " ^ command);
|
||||
Sys.command command
|
||||
|
||||
(** {1 Driver} *)
|
||||
|
||||
let get_catala_files_in_folder (dir : string) : string list =
|
||||
let rec loop result = function
|
||||
| f :: fs ->
|
||||
let f_is_dir =
|
||||
try Sys.is_directory f
|
||||
with Sys_error e ->
|
||||
Printf.sprintf "skipping %s" e |> Cli.warning_print;
|
||||
false
|
||||
in
|
||||
if f_is_dir then
|
||||
Sys.readdir f |> Array.to_list
|
||||
|> List.map (Filename.concat f)
|
||||
|> List.append fs |> loop result
|
||||
else loop (f :: result) fs
|
||||
| [] -> result
|
||||
in
|
||||
let all_files_in_folder = loop [] [ dir ] in
|
||||
List.filter (Re.Pcre.pmatch ~rex:catala_suffix_regex) all_files_in_folder
|
||||
|
||||
type ninja_building_context = {
|
||||
last_valid_ninja : ninja;
|
||||
curr_ninja : ninja option;
|
||||
all_file_names : string list;
|
||||
all_test_builds : string;
|
||||
all_failed_names : string list;
|
||||
}
|
||||
(** Record used to keep tracks of the current context while building the [Ninja_utils.ninja].*)
|
||||
|
||||
(** [ninja_building_context_init ninja_init] returns the empty context corresponding to
|
||||
[ninja_init]. *)
|
||||
let ninja_building_context_init (ninja_init : Nj.ninja) : ninja_building_context =
|
||||
{
|
||||
last_valid_ninja = ninja_init;
|
||||
curr_ninja = Some ninja_init;
|
||||
all_file_names = [];
|
||||
all_test_builds = "";
|
||||
all_failed_names = [];
|
||||
}
|
||||
|
||||
(** [collect_in_directory ctx file_or_folder ninja_start reset_test_outputs] updates the building
|
||||
context [ctx] by adding new ninja build statements needed to test files in [folder].*)
|
||||
let collect_in_folder (ctx : ninja_building_context) (folder : string) (ninja_start : Nj.ninja)
|
||||
(reset_test_outputs : bool) : ninja_building_context =
|
||||
let ninja, test_file_names =
|
||||
List.fold_left
|
||||
(fun (ninja, test_file_names) file ->
|
||||
match collect_all_ninja_build ninja file reset_test_outputs with
|
||||
| None ->
|
||||
(* Skips none Catala file. *)
|
||||
(ninja, test_file_names)
|
||||
| Some (test_file_name, ninja) -> (ninja, test_file_names ^ " $\n " ^ test_file_name))
|
||||
(ninja_start, "")
|
||||
(get_catala_files_in_folder folder)
|
||||
in
|
||||
let test_dir_name = Printf.sprintf "test_dir_%s" (folder |> Nj.Build.unpath) in
|
||||
let curr_ninja =
|
||||
if 0 = String.length test_file_names then None
|
||||
else
|
||||
Some
|
||||
{
|
||||
ninja with
|
||||
builds =
|
||||
Nj.BuildMap.add test_dir_name
|
||||
(Nj.Build.make_with_vars_and_inputs ~outputs:[ Nj.Expr.Lit test_dir_name ]
|
||||
~rule:"run_and_display_final_message" ~inputs:[ Nj.Expr.Lit test_file_names ]
|
||||
~vars:[ ("test_file_or_folder", Nj.Expr.Lit ("in folder '" ^ folder ^ "'")) ])
|
||||
ninja.builds;
|
||||
}
|
||||
in
|
||||
if Option.is_some curr_ninja then
|
||||
{
|
||||
ctx with
|
||||
last_valid_ninja = ninja_start;
|
||||
curr_ninja;
|
||||
all_file_names = folder :: ctx.all_file_names;
|
||||
all_test_builds = ctx.all_test_builds ^ " $\n " ^ test_dir_name;
|
||||
}
|
||||
else
|
||||
{
|
||||
ctx with
|
||||
last_valid_ninja = ninja_start;
|
||||
curr_ninja;
|
||||
all_failed_names = folder :: ctx.all_failed_names;
|
||||
}
|
||||
|
||||
(** [collect_in_file ctx file_or_folder ninja_start reset_test_outputs] updates the building context
|
||||
[ctx] by adding new ninja build statements needed to test the [tested_file].*)
|
||||
let collect_in_file (ctx : ninja_building_context) (tested_file : string) (ninja_start : Nj.ninja)
|
||||
(reset_test_outputs : bool) : ninja_building_context =
|
||||
match collect_all_ninja_build ninja_start tested_file reset_test_outputs with
|
||||
| Some (test_file_name, ninja) ->
|
||||
{
|
||||
ctx with
|
||||
last_valid_ninja = ninja;
|
||||
curr_ninja = Some ninja;
|
||||
all_file_names = tested_file :: ctx.all_file_names;
|
||||
all_test_builds = ctx.all_test_builds ^ " $\n " ^ test_file_name;
|
||||
}
|
||||
| None ->
|
||||
{
|
||||
ctx with
|
||||
last_valid_ninja = ninja_start;
|
||||
curr_ninja = None;
|
||||
all_failed_names = tested_file :: ctx.all_failed_names;
|
||||
}
|
||||
|
||||
(** {1 Return code values} *)
|
||||
|
||||
let return_ok = 0
|
||||
|
||||
let return_err = 1
|
||||
|
||||
let driver (files_or_folders : string list) (command : string) (catala_exe : string option)
|
||||
(catala_opts : string option) (debug : bool) (scope : string option) (reset_test_outputs : bool)
|
||||
(ninja_output : string option) : int =
|
||||
if debug then Cli.debug_flag := true;
|
||||
let files_or_folders = List.sort_uniq String.compare files_or_folders in
|
||||
let catala_exe = Option.fold ~none:"catala" ~some:Fun.id catala_exe in
|
||||
let catala_opts = Option.fold ~none:"" ~some:Fun.id catala_opts in
|
||||
let ninja_output =
|
||||
Option.fold ~none:(Filename.temp_file "clerk_build" ".ninja") ~some:Fun.id ninja_output
|
||||
in
|
||||
match String.lowercase_ascii command with
|
||||
| "test" ->
|
||||
Cli.debug_print "building ninja rules...";
|
||||
let ctx =
|
||||
List.fold_left
|
||||
(fun ctx file_or_folder ->
|
||||
let curr_ninja =
|
||||
match ctx.curr_ninja with Some ninja -> ninja | None -> ctx.last_valid_ninja
|
||||
in
|
||||
if Sys.is_directory file_or_folder then
|
||||
collect_in_folder ctx file_or_folder curr_ninja reset_test_outputs
|
||||
else collect_in_file ctx file_or_folder curr_ninja reset_test_outputs)
|
||||
(ninja_building_context_init (ninja_start catala_exe catala_opts))
|
||||
files_or_folders
|
||||
in
|
||||
let there_is_some_fails = 0 <> List.length ctx.all_failed_names in
|
||||
let ninja = match ctx.curr_ninja with Some ninja -> ninja | None -> ctx.last_valid_ninja in
|
||||
if there_is_some_fails then
|
||||
List.iter
|
||||
(fun f ->
|
||||
f
|
||||
|> Cli.print_with_style [ ANSITerminal.magenta ] "%s"
|
||||
|> Printf.sprintf "No test case found for %s"
|
||||
|> Cli.warning_print)
|
||||
ctx.all_failed_names;
|
||||
if 0 = List.compare_lengths ctx.all_failed_names files_or_folders then return_ok
|
||||
else
|
||||
let out = open_out ninja_output in
|
||||
Cli.debug_print ("writing " ^ ninja_output ^ "...");
|
||||
Nj.format
|
||||
(Format.formatter_of_out_channel out)
|
||||
(add_root_test_build ninja ctx.all_file_names ctx.all_test_builds);
|
||||
close_out out;
|
||||
let ninja_cmd = "ninja test -f " ^ ninja_output in
|
||||
Cli.debug_print ("executing '" ^ ninja_cmd ^ "'...");
|
||||
Sys.command ninja_cmd
|
||||
| "run" -> (
|
||||
match scope with
|
||||
| Some scope ->
|
||||
let res =
|
||||
List.fold_left
|
||||
(fun ret f -> ret + run_file f catala_exe catala_opts scope)
|
||||
0 files_or_folders
|
||||
in
|
||||
if 0 <> res then return_err else return_ok
|
||||
| None ->
|
||||
Cli.error_print "Please provide a scope to run with the -s option";
|
||||
1)
|
||||
| _ ->
|
||||
Cli.error_print (Format.asprintf "The command \"%s\" is unknown to clerk." command);
|
||||
1
|
||||
|
||||
let _ =
|
||||
let return_code = Cmdliner.Term.eval (clerk_t driver, info) in
|
||||
match return_code with
|
||||
| `Ok 0 -> Cmdliner.Term.exit (`Ok 0)
|
||||
| _ -> Cmdliner.Term.exit (`Error `Term)
|
||||
let _ = Clerk_driver.main ()
|
||||
|
649
build_system/clerk_driver.ml
Normal file
649
build_system/clerk_driver.ml
Normal file
@ -0,0 +1,649 @@
|
||||
(* 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 Cmdliner
|
||||
open Utils
|
||||
open Ninja_utils
|
||||
module Nj = Ninja_utils
|
||||
|
||||
(** {1 Command line interface} *)
|
||||
|
||||
let files_or_folders =
|
||||
Arg.(
|
||||
non_empty & pos_right 0 file [] & info [] ~docv:"FILE(S)" ~doc:"File(s) or folder(s) to process")
|
||||
|
||||
let command =
|
||||
Arg.(
|
||||
required
|
||||
& pos 0 (some string) None
|
||||
& info [] ~docv:"COMMAND" ~doc:"Command selection among: test, run")
|
||||
|
||||
let debug = Arg.(value & flag & info [ "debug"; "d" ] ~doc:"Prints debug information")
|
||||
|
||||
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 catalac =
|
||||
Arg.(
|
||||
value
|
||||
& opt (some string) None
|
||||
& info [ "e"; "exe" ] ~docv:"EXE" ~doc:"Catala compiler executable, defaults to `catala`")
|
||||
|
||||
let ninja_output =
|
||||
Arg.(
|
||||
value
|
||||
& opt (some file) None
|
||||
& info [ "o"; "output" ] ~docv:"OUTPUT"
|
||||
~doc:
|
||||
"$(i, OUTPUT) is the file that will contain the build.ninja file output. If not \
|
||||
specified, the build.ninja file will be outputed in the temporary directory of the \
|
||||
system.")
|
||||
|
||||
let scope =
|
||||
Arg.(
|
||||
value
|
||||
& 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 catala_opts =
|
||||
Arg.(
|
||||
value
|
||||
& opt (some string) None
|
||||
& info [ "c"; "catala-opts" ] ~docv:"LANG" ~doc:"Options to pass to the Catala compiler")
|
||||
|
||||
let clerk_t f =
|
||||
Term.(
|
||||
const f $ files_or_folders $ command $ catalac $ catala_opts $ debug $ scope
|
||||
$ reset_test_outputs $ ninja_output)
|
||||
|
||||
let version = "0.5.0"
|
||||
|
||||
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_commands;
|
||||
`I
|
||||
( "test",
|
||||
"Tests a Catala source file given expected outputs provided in a directory called \
|
||||
`output` at the same level that the tested file. If the tested file is `foo.catala_en`, \
|
||||
then `output` should contain expected output files like `foo.catala_en.$(i,BACKEND)` \
|
||||
where $(i,BACKEND) is chosen among: `Interpret`, `Dcalc`, `Scalc`, `Lcalc`, \
|
||||
`Typecheck, `Scopelang`, `html`, `tex`, `py`, `ml` and `d` (for Makefile dependencies). \
|
||||
For the `Interpret` backend, the scope to test is selected by naming the expected \
|
||||
output file `foo.catala_en.$(i,SCOPE).interpret`. When the argument of $(b,clerk) is a \
|
||||
folder, it recursively looks for Catala files coupled with `output` directories and \
|
||||
matching expected output on which to perform tests." );
|
||||
`I
|
||||
("run", "Runs the Catala interpreter on a given scope of a given file. See the `-s` option.");
|
||||
`S Manpage.s_authors;
|
||||
`P "Denis Merigoux <denis.merigoux@inria.fr>";
|
||||
`P "Emile Rolley <emile.rolley@tuta.io>";
|
||||
`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 = Term.default_exits @ [ Term.exit_info ~doc:"on error." 1 ] in
|
||||
Term.info "clerk" ~version ~doc ~exits ~man
|
||||
|
||||
(**{1 Testing}*)
|
||||
|
||||
let catala_backend_to_string (backend : Cli.backend_option) : string =
|
||||
match backend with
|
||||
| Cli.Dcalc -> "Dcalc"
|
||||
| Cli.Html -> "Html"
|
||||
| Cli.Interpret -> "Interpret"
|
||||
| Cli.Latex -> "Latex"
|
||||
| Cli.Lcalc -> "Lcalc"
|
||||
| Cli.Makefile -> "Makefile"
|
||||
| Cli.OCaml -> "OCaml"
|
||||
| Cli.Proof -> "Proof"
|
||||
| Cli.Python -> "Python"
|
||||
| Cli.Scalc -> "Scalc"
|
||||
| Cli.Scopelang -> "Scopelang"
|
||||
| Cli.Typecheck -> "Typecheck"
|
||||
|
||||
type expected_output_descr = {
|
||||
base_filename : string;
|
||||
output_dir : string;
|
||||
complete_filename : string;
|
||||
backend : Cli.backend_option;
|
||||
scope : string option;
|
||||
}
|
||||
|
||||
let catala_suffix_regex = Re.Pcre.regexp "\\.catala_(\\w){2}"
|
||||
|
||||
let filename_to_expected_output_descr (output_dir : string) (filename : string) :
|
||||
expected_output_descr option =
|
||||
let complete_filename = filename in
|
||||
let first_extension = Filename.extension filename in
|
||||
let filename = Filename.remove_extension filename in
|
||||
let backend =
|
||||
match String.lowercase_ascii first_extension with
|
||||
| ".dcalc" -> Some Cli.Dcalc
|
||||
| ".d" -> Some Cli.Makefile
|
||||
| ".html" -> Some Cli.Html
|
||||
| ".interpret" -> Some Cli.Interpret
|
||||
| ".lcalc" -> Some Cli.Lcalc
|
||||
| ".ml" -> Some Cli.OCaml
|
||||
| ".proof" -> Some Cli.Proof
|
||||
| ".py" -> Some Cli.Python
|
||||
| ".scalc" -> Some Cli.Scalc
|
||||
| ".scopelang" -> Some Cli.Scopelang
|
||||
| ".tex" -> Some Cli.Latex
|
||||
| ".typecheck" -> Some Cli.Typecheck
|
||||
| _ -> None
|
||||
in
|
||||
match backend with
|
||||
| None -> None
|
||||
| Some backend ->
|
||||
let second_extension = Filename.extension filename in
|
||||
let base_filename, scope =
|
||||
if Re.Pcre.pmatch ~rex:catala_suffix_regex second_extension then (filename, None)
|
||||
else
|
||||
let scope_name_regex = Re.Pcre.regexp "\\.(.+)" in
|
||||
let scope_name = (Re.Pcre.extract ~rex:scope_name_regex second_extension).(1) in
|
||||
(Filename.remove_extension filename, Some scope_name)
|
||||
in
|
||||
Some { output_dir; complete_filename; base_filename; backend; scope }
|
||||
|
||||
(** Given a file, looks in the relative [output] directory if there are files with the same base
|
||||
name that contain expected outputs for different *)
|
||||
let search_for_expected_outputs (file : string) : expected_output_descr list =
|
||||
let output_dir = Filename.dirname file ^ Filename.dir_sep ^ "output/" in
|
||||
let output_files = try Sys.readdir output_dir with Sys_error _ -> Array.make 0 "" in
|
||||
List.filter_map
|
||||
(fun output_file ->
|
||||
match filename_to_expected_output_descr output_dir output_file with
|
||||
| None -> None
|
||||
| Some expected_output ->
|
||||
if expected_output.base_filename = Filename.basename file then Some expected_output
|
||||
else None)
|
||||
(Array.to_list output_files)
|
||||
|
||||
let add_reset_rules_aux ~(redirect : string) ~(with_scope_output_rule : string)
|
||||
~(without_scope_output_rule : string) (catala_exe_opts : string) (rules : Rule.t Nj.RuleMap.t) :
|
||||
Rule.t Nj.RuleMap.t =
|
||||
let reset_common_cmd_exprs =
|
||||
Nj.Expr.
|
||||
[
|
||||
Var "catala_cmd";
|
||||
Var "tested_file";
|
||||
Var "extra_flags";
|
||||
Lit "--unstyled";
|
||||
Lit redirect;
|
||||
Var "expected_output";
|
||||
Lit "2>&1";
|
||||
]
|
||||
in
|
||||
let reset_with_scope_rule =
|
||||
Nj.Rule.make with_scope_output_rule
|
||||
~command:
|
||||
Nj.Expr.(Seq ([ Lit catala_exe_opts; Lit "-s"; Var "scope" ] @ reset_common_cmd_exprs))
|
||||
~description:
|
||||
Nj.Expr.(
|
||||
Seq
|
||||
[
|
||||
Lit "RESET scope";
|
||||
Var "scope";
|
||||
Lit "of file";
|
||||
Var "tested_file";
|
||||
Lit "with the";
|
||||
Var "catala_cmd";
|
||||
Lit "command";
|
||||
])
|
||||
in
|
||||
let reset_without_scope_rule =
|
||||
Nj.Rule.make without_scope_output_rule
|
||||
~command:Nj.Expr.(Seq (Lit catala_exe_opts :: reset_common_cmd_exprs))
|
||||
~description:
|
||||
Nj.Expr.(
|
||||
Seq
|
||||
[
|
||||
Lit "RESET";
|
||||
Lit "file";
|
||||
Var "tested_file";
|
||||
Lit "with the";
|
||||
Var "catala_cmd";
|
||||
Lit "command";
|
||||
])
|
||||
in
|
||||
Nj.RuleMap.(
|
||||
rules
|
||||
|> add reset_with_scope_rule.name reset_with_scope_rule
|
||||
|> add reset_without_scope_rule.name reset_without_scope_rule)
|
||||
|
||||
let add_test_rules_aux ~(test_common_cmd_exprs : Expr.t list) ~(with_scope_output_rule : string)
|
||||
~(without_scope_output_rule : string) (catala_exe_opts : string) (rules : Rule.t Nj.RuleMap.t) :
|
||||
Rule.t Nj.RuleMap.t =
|
||||
let test_with_scope_rule =
|
||||
Nj.Rule.make with_scope_output_rule
|
||||
~command:
|
||||
Nj.Expr.(Seq ([ Lit catala_exe_opts; Lit "-s"; Var "scope" ] @ test_common_cmd_exprs))
|
||||
~description:
|
||||
Nj.Expr.(
|
||||
Seq
|
||||
[
|
||||
Lit "TEST scope";
|
||||
Var "scope";
|
||||
Lit "of file";
|
||||
Var "tested_file";
|
||||
Lit "with the";
|
||||
Var "catala_cmd";
|
||||
Lit "command";
|
||||
])
|
||||
in
|
||||
let test_without_scope_rule =
|
||||
Nj.Rule.make without_scope_output_rule
|
||||
~command:Nj.Expr.(Seq (Lit catala_exe_opts :: test_common_cmd_exprs))
|
||||
~description:
|
||||
Nj.Expr.(
|
||||
Seq
|
||||
[
|
||||
Lit "TEST on file"; Var "tested_file"; Lit "with the"; Var "catala_cmd"; Lit "command";
|
||||
])
|
||||
in
|
||||
Nj.RuleMap.(
|
||||
rules
|
||||
|> add test_with_scope_rule.name test_with_scope_rule
|
||||
|> add test_without_scope_rule.name test_without_scope_rule)
|
||||
|
||||
(** [add_reset_rules catala_exe_opts rules] adds ninja rules used to reset test files into [rules]
|
||||
and returns it.*)
|
||||
let add_reset_rules (catala_exe_opts : string) (rules : Rule.t Nj.RuleMap.t) : Rule.t Nj.RuleMap.t =
|
||||
add_reset_rules_aux ~with_scope_output_rule:"reset_with_scope"
|
||||
~without_scope_output_rule:"reset_without_scope" ~redirect:">" catala_exe_opts rules
|
||||
|
||||
(** [add_test_rules catala_exe_opts rules] adds ninja rules used to test files into [rules] and
|
||||
returns it.*)
|
||||
let add_test_rules (catala_exe_opts : string) (rules : Rule.t Nj.RuleMap.t) : Rule.t Nj.RuleMap.t =
|
||||
let test_common_cmd_exprs =
|
||||
Nj.Expr.
|
||||
[
|
||||
Var "catala_cmd";
|
||||
Var "tested_file";
|
||||
Var "extra_flags";
|
||||
Lit "--unstyled";
|
||||
Lit "2>&1 | colordiff -u -b";
|
||||
Var "expected_output";
|
||||
Lit "-";
|
||||
]
|
||||
in
|
||||
add_test_rules_aux ~test_common_cmd_exprs ~with_scope_output_rule:"test_with_scope"
|
||||
~without_scope_output_rule:"test_without_scope" catala_exe_opts rules
|
||||
|
||||
(** [add_reset_with_ouput_rules catala_exe_opts rules] adds ninja rules used to reset test files
|
||||
using an output flag into [rules] and returns it.*)
|
||||
let add_reset_with_output_rules (catala_exe_opts : string) (rules : Rule.t Nj.RuleMap.t) :
|
||||
Rule.t Nj.RuleMap.t =
|
||||
add_reset_rules_aux ~with_scope_output_rule:"reset_with_scope_and_output"
|
||||
~without_scope_output_rule:"reset_without_scope_and_output" ~redirect:"-o" catala_exe_opts rules
|
||||
|
||||
(** [add_test_with_output_rules catala_exe_opts rules] adds ninja rules used to test files using an
|
||||
output flag into [rules] and returns it.*)
|
||||
let add_test_with_output_rules (catala_exe_opts : string) (rules : Rule.t Nj.RuleMap.t) :
|
||||
Rule.t Nj.RuleMap.t =
|
||||
let test_common_cmd_exprs =
|
||||
Nj.Expr.
|
||||
[
|
||||
Var "catala_cmd";
|
||||
Var "tested_file";
|
||||
Var "extra_flags";
|
||||
Lit "--unstyled";
|
||||
Lit "-o";
|
||||
Var "tmp_file";
|
||||
Lit "; colordiff -u -b";
|
||||
Var "expected_output";
|
||||
Var "tmp_file";
|
||||
]
|
||||
in
|
||||
add_test_rules_aux ~test_common_cmd_exprs ~with_scope_output_rule:"test_with_scope_and_output"
|
||||
~without_scope_output_rule:"test_without_scope_and_output" catala_exe_opts rules
|
||||
|
||||
(** [ninja_start catala_exe] returns the inital [ninja] data structure with rules needed to reset
|
||||
and test files. *)
|
||||
let ninja_start (catala_exe : string) (catala_opts : string) : ninja =
|
||||
let catala_exe_opts = catala_exe ^ " " ^ catala_opts in
|
||||
let run_and_display_final_message =
|
||||
Nj.Rule.make "run_and_display_final_message"
|
||||
~command:Nj.Expr.(Seq [ Lit ":" ])
|
||||
~description:Nj.Expr.(Seq [ Lit "All tests"; Var "test_file_or_folder"; Lit "passed!" ])
|
||||
in
|
||||
{
|
||||
rules =
|
||||
Nj.RuleMap.(
|
||||
empty |> add_reset_rules catala_exe_opts |> add_test_rules catala_exe_opts
|
||||
|> add_test_with_output_rules catala_exe_opts
|
||||
|> add_reset_with_output_rules catala_exe_opts
|
||||
|> add run_and_display_final_message.name run_and_display_final_message);
|
||||
builds = Nj.BuildMap.empty;
|
||||
}
|
||||
|
||||
(** [collect_all_ninja_build ninja tested_file catala_exe catala_opts reset_test_outputs] creates
|
||||
and returns all ninja build statements needed to test the [tested_file]. *)
|
||||
let collect_all_ninja_build (ninja : ninja) (tested_file : string) (reset_test_outputs : bool) :
|
||||
(string * ninja) option =
|
||||
let expected_outputs = search_for_expected_outputs tested_file in
|
||||
if List.length expected_outputs = 0 then (
|
||||
Cli.debug_print (Format.asprintf "No expected outputs were found for test file %s" tested_file);
|
||||
None)
|
||||
else
|
||||
let ninja, test_names =
|
||||
List.fold_left
|
||||
(fun (ninja, test_names) expected_output ->
|
||||
let vars =
|
||||
[
|
||||
("catala_cmd", Nj.Expr.Lit (catala_backend_to_string expected_output.backend));
|
||||
("tested_file", Nj.Expr.Lit tested_file);
|
||||
( "expected_output",
|
||||
Nj.Expr.Lit (expected_output.output_dir ^ expected_output.complete_filename) );
|
||||
]
|
||||
in
|
||||
let output_build_kind = if reset_test_outputs then "reset" else "test" in
|
||||
let catala_backend = catala_backend_to_string expected_output.backend in
|
||||
|
||||
let get_rule_infos ?(rule_postfix = "") :
|
||||
string option -> string * string * (string * Nj.Expr.t) list = function
|
||||
| Some scope ->
|
||||
( Printf.sprintf "%s_%s_%s_%s" output_build_kind scope catala_backend tested_file
|
||||
|> Nj.Build.unpath,
|
||||
output_build_kind ^ "_with_scope" ^ rule_postfix,
|
||||
("scope", Nj.Expr.Lit scope) :: vars )
|
||||
| None ->
|
||||
( Printf.sprintf "%s_%s_%s" output_build_kind catala_backend tested_file
|
||||
|> Nj.Build.unpath,
|
||||
output_build_kind ^ "_without_scope" ^ rule_postfix,
|
||||
vars )
|
||||
in
|
||||
|
||||
let ninja_add_new_rule (rule_output : string) (rule : string)
|
||||
(vars : (string * Nj.Expr.t) list) (ninja : ninja) : ninja =
|
||||
{
|
||||
ninja with
|
||||
builds =
|
||||
Nj.BuildMap.add rule_output
|
||||
(Nj.Build.make_with_vars ~outputs:[ Nj.Expr.Lit rule_output ] ~rule ~vars)
|
||||
ninja.builds;
|
||||
}
|
||||
in
|
||||
|
||||
match expected_output.backend with
|
||||
| Cli.Interpret | Cli.Proof | Cli.Typecheck | Cli.Dcalc | Cli.Scopelang | Cli.Scalc
|
||||
| Cli.Lcalc ->
|
||||
let rule_output, rule_name, rule_vars = get_rule_infos expected_output.scope in
|
||||
let rule_vars =
|
||||
match expected_output.backend with
|
||||
| Cli.Proof ->
|
||||
("extra_flags", Nj.Expr.Lit "--disable_counterexamples") :: rule_vars
|
||||
(* Counterexamples can be different at each call because of the randomness
|
||||
inside SMT solver, so we can't expect their value to remain constant. Hence
|
||||
we disable the counterexamples when testing the replication of failed
|
||||
proofs. *)
|
||||
| _ -> rule_vars
|
||||
in
|
||||
( ninja_add_new_rule rule_output rule_name rule_vars ninja,
|
||||
test_names ^ " $\n " ^ rule_output )
|
||||
| Cli.Python | Cli.OCaml | Cli.Latex | Cli.Html | Cli.Makefile ->
|
||||
let tmp_file = Filename.temp_file "clerk_" ("_" ^ catala_backend) in
|
||||
let rule_output, rule_name, rule_vars =
|
||||
get_rule_infos ~rule_postfix:"_and_output" expected_output.scope
|
||||
in
|
||||
let rule_vars = ("tmp_file", Nj.Expr.Lit tmp_file) :: rule_vars in
|
||||
( ninja_add_new_rule rule_output rule_name rule_vars ninja,
|
||||
test_names ^ " $\n " ^ rule_output ))
|
||||
(ninja, "") expected_outputs
|
||||
in
|
||||
let test_name =
|
||||
tested_file
|
||||
|> (if reset_test_outputs then Printf.sprintf "reset_file_%s"
|
||||
else Printf.sprintf "test_file_%s")
|
||||
|> Nj.Build.unpath
|
||||
in
|
||||
Some
|
||||
( test_name,
|
||||
{
|
||||
ninja with
|
||||
builds =
|
||||
Nj.BuildMap.add test_name
|
||||
(Nj.Build.make_with_inputs ~outputs:[ Nj.Expr.Lit test_name ] ~rule:"phony"
|
||||
~inputs:[ Nj.Expr.Lit test_names ])
|
||||
ninja.builds;
|
||||
} )
|
||||
|
||||
(** [add_root_test_build ninja all_file_names all_test_builds] add the 'test' ninja build
|
||||
declaration calling the rule 'run_and_display_final_message' for [all_test_builds] which
|
||||
correspond to [all_file_names]. *)
|
||||
let add_root_test_build (ninja : ninja) (all_file_names : string list) (all_test_builds : string) :
|
||||
ninja =
|
||||
let file_names_str =
|
||||
List.hd all_file_names ^ ""
|
||||
^ List.fold_left (fun acc name -> acc ^ "; " ^ name) "" (List.tl all_file_names)
|
||||
in
|
||||
{
|
||||
ninja with
|
||||
builds =
|
||||
Nj.BuildMap.add "test"
|
||||
(Nj.Build.make_with_vars_and_inputs ~outputs:[ Nj.Expr.Lit "test" ]
|
||||
~rule:"run_and_display_final_message" ~inputs:[ Nj.Expr.Lit all_test_builds ]
|
||||
~vars:[ ("test_file_or_folder", Nj.Expr.Lit ("in [ " ^ file_names_str ^ " ]")) ])
|
||||
ninja.builds;
|
||||
}
|
||||
|
||||
(**{1 Running}*)
|
||||
|
||||
let run_file (file : string) (catala_exe : string) (catala_opts : string) (scope : string) : int =
|
||||
let command =
|
||||
String.concat " "
|
||||
(List.filter (fun s -> s <> "") [ catala_exe; catala_opts; "-s " ^ scope; "Interpret"; file ])
|
||||
in
|
||||
Cli.debug_print ("Running: " ^ command);
|
||||
Sys.command command
|
||||
|
||||
(** {1 Driver} *)
|
||||
|
||||
let get_catala_files_in_folder (dir : string) : string list =
|
||||
let rec loop result = function
|
||||
| f :: fs ->
|
||||
let f_is_dir =
|
||||
try Sys.is_directory f
|
||||
with Sys_error e ->
|
||||
Printf.sprintf "skipping %s" e |> Cli.warning_print;
|
||||
false
|
||||
in
|
||||
if f_is_dir then
|
||||
Sys.readdir f |> Array.to_list
|
||||
|> List.map (Filename.concat f)
|
||||
|> List.append fs |> loop result
|
||||
else loop (f :: result) fs
|
||||
| [] -> result
|
||||
in
|
||||
let all_files_in_folder = loop [] [ dir ] in
|
||||
List.filter (Re.Pcre.pmatch ~rex:catala_suffix_regex) all_files_in_folder
|
||||
|
||||
type ninja_building_context = {
|
||||
last_valid_ninja : ninja;
|
||||
curr_ninja : ninja option;
|
||||
all_file_names : string list;
|
||||
all_test_builds : string;
|
||||
all_failed_names : string list;
|
||||
}
|
||||
(** Record used to keep tracks of the current context while building the [Ninja_utils.ninja].*)
|
||||
|
||||
(** [ninja_building_context_init ninja_init] returns the empty context corresponding to
|
||||
[ninja_init]. *)
|
||||
let ninja_building_context_init (ninja_init : Nj.ninja) : ninja_building_context =
|
||||
{
|
||||
last_valid_ninja = ninja_init;
|
||||
curr_ninja = Some ninja_init;
|
||||
all_file_names = [];
|
||||
all_test_builds = "";
|
||||
all_failed_names = [];
|
||||
}
|
||||
|
||||
(** [collect_in_directory ctx file_or_folder ninja_start reset_test_outputs] updates the building
|
||||
context [ctx] by adding new ninja build statements needed to test files in [folder].*)
|
||||
let collect_in_folder (ctx : ninja_building_context) (folder : string) (ninja_start : Nj.ninja)
|
||||
(reset_test_outputs : bool) : ninja_building_context =
|
||||
let ninja, test_file_names =
|
||||
List.fold_left
|
||||
(fun (ninja, test_file_names) file ->
|
||||
match collect_all_ninja_build ninja file reset_test_outputs with
|
||||
| None ->
|
||||
(* Skips none Catala file. *)
|
||||
(ninja, test_file_names)
|
||||
| Some (test_file_name, ninja) -> (ninja, test_file_names ^ " $\n " ^ test_file_name))
|
||||
(ninja_start, "")
|
||||
(get_catala_files_in_folder folder)
|
||||
in
|
||||
let test_dir_name = Printf.sprintf "test_dir_%s" (folder |> Nj.Build.unpath) in
|
||||
let curr_ninja =
|
||||
if 0 = String.length test_file_names then None
|
||||
else
|
||||
Some
|
||||
{
|
||||
ninja with
|
||||
builds =
|
||||
Nj.BuildMap.add test_dir_name
|
||||
(Nj.Build.make_with_vars_and_inputs ~outputs:[ Nj.Expr.Lit test_dir_name ]
|
||||
~rule:"run_and_display_final_message" ~inputs:[ Nj.Expr.Lit test_file_names ]
|
||||
~vars:[ ("test_file_or_folder", Nj.Expr.Lit ("in folder '" ^ folder ^ "'")) ])
|
||||
ninja.builds;
|
||||
}
|
||||
in
|
||||
if Option.is_some curr_ninja then
|
||||
{
|
||||
ctx with
|
||||
last_valid_ninja = ninja_start;
|
||||
curr_ninja;
|
||||
all_file_names = folder :: ctx.all_file_names;
|
||||
all_test_builds = ctx.all_test_builds ^ " $\n " ^ test_dir_name;
|
||||
}
|
||||
else
|
||||
{
|
||||
ctx with
|
||||
last_valid_ninja = ninja_start;
|
||||
curr_ninja;
|
||||
all_failed_names = folder :: ctx.all_failed_names;
|
||||
}
|
||||
|
||||
(** [collect_in_file ctx file_or_folder ninja_start reset_test_outputs] updates the building context
|
||||
[ctx] by adding new ninja build statements needed to test the [tested_file].*)
|
||||
let collect_in_file (ctx : ninja_building_context) (tested_file : string) (ninja_start : Nj.ninja)
|
||||
(reset_test_outputs : bool) : ninja_building_context =
|
||||
match collect_all_ninja_build ninja_start tested_file reset_test_outputs with
|
||||
| Some (test_file_name, ninja) ->
|
||||
{
|
||||
ctx with
|
||||
last_valid_ninja = ninja;
|
||||
curr_ninja = Some ninja;
|
||||
all_file_names = tested_file :: ctx.all_file_names;
|
||||
all_test_builds = ctx.all_test_builds ^ " $\n " ^ test_file_name;
|
||||
}
|
||||
| None ->
|
||||
{
|
||||
ctx with
|
||||
last_valid_ninja = ninja_start;
|
||||
curr_ninja = None;
|
||||
all_failed_names = tested_file :: ctx.all_failed_names;
|
||||
}
|
||||
|
||||
(** {1 Return code values} *)
|
||||
|
||||
let return_ok = 0
|
||||
|
||||
let return_err = 1
|
||||
|
||||
let driver (files_or_folders : string list) (command : string) (catala_exe : string option)
|
||||
(catala_opts : string option) (debug : bool) (scope : string option) (reset_test_outputs : bool)
|
||||
(ninja_output : string option) : int =
|
||||
if debug then Cli.debug_flag := true;
|
||||
let files_or_folders = List.sort_uniq String.compare files_or_folders in
|
||||
let catala_exe = Option.fold ~none:"catala" ~some:Fun.id catala_exe in
|
||||
let catala_opts = Option.fold ~none:"" ~some:Fun.id catala_opts in
|
||||
let ninja_output =
|
||||
Option.fold ~none:(Filename.temp_file "clerk_build" ".ninja") ~some:Fun.id ninja_output
|
||||
in
|
||||
match String.lowercase_ascii command with
|
||||
| "test" ->
|
||||
Cli.debug_print "building ninja rules...";
|
||||
let ctx =
|
||||
List.fold_left
|
||||
(fun ctx file_or_folder ->
|
||||
let curr_ninja =
|
||||
match ctx.curr_ninja with Some ninja -> ninja | None -> ctx.last_valid_ninja
|
||||
in
|
||||
if Sys.is_directory file_or_folder then
|
||||
collect_in_folder ctx file_or_folder curr_ninja reset_test_outputs
|
||||
else collect_in_file ctx file_or_folder curr_ninja reset_test_outputs)
|
||||
(ninja_building_context_init (ninja_start catala_exe catala_opts))
|
||||
files_or_folders
|
||||
in
|
||||
let there_is_some_fails = 0 <> List.length ctx.all_failed_names in
|
||||
let ninja = match ctx.curr_ninja with Some ninja -> ninja | None -> ctx.last_valid_ninja in
|
||||
if there_is_some_fails then
|
||||
List.iter
|
||||
(fun f ->
|
||||
f
|
||||
|> Cli.print_with_style [ ANSITerminal.magenta ] "%s"
|
||||
|> Printf.sprintf "No test case found for %s"
|
||||
|> Cli.warning_print)
|
||||
ctx.all_failed_names;
|
||||
if 0 = List.compare_lengths ctx.all_failed_names files_or_folders then return_ok
|
||||
else
|
||||
let out = open_out ninja_output in
|
||||
Cli.debug_print ("writing " ^ ninja_output ^ "...");
|
||||
Nj.format
|
||||
(Format.formatter_of_out_channel out)
|
||||
(add_root_test_build ninja ctx.all_file_names ctx.all_test_builds);
|
||||
close_out out;
|
||||
let ninja_cmd = "ninja test -f " ^ ninja_output in
|
||||
Cli.debug_print ("executing '" ^ ninja_cmd ^ "'...");
|
||||
Sys.command ninja_cmd
|
||||
| "run" -> (
|
||||
match scope with
|
||||
| Some scope ->
|
||||
let res =
|
||||
List.fold_left
|
||||
(fun ret f -> ret + run_file f catala_exe catala_opts scope)
|
||||
0 files_or_folders
|
||||
in
|
||||
if 0 <> res then return_err else return_ok
|
||||
| None ->
|
||||
Cli.error_print "Please provide a scope to run with the -s option";
|
||||
1)
|
||||
| _ ->
|
||||
Cli.error_print (Format.asprintf "The command \"%s\" is unknown to clerk." command);
|
||||
1
|
||||
|
||||
let main () =
|
||||
let return_code = Cmdliner.Term.eval (clerk_t driver, info) in
|
||||
match return_code with
|
||||
| `Ok 0 -> Cmdliner.Term.exit (`Ok 0)
|
||||
| _ -> Cmdliner.Term.exit (`Error `Term)
|
@ -1,12 +1,18 @@
|
||||
(executable
|
||||
(name clerk)
|
||||
(public_name clerk)
|
||||
(libraries catala.runtime catala.utils cmdliner re ANSITerminal ninja_utils)
|
||||
(modules clerk)
|
||||
(package catala))
|
||||
|
||||
(library
|
||||
(name ninja_utils)
|
||||
(public_name ninja_utils)
|
||||
(modules ninja_utils)
|
||||
(libraries re))
|
||||
|
||||
(library
|
||||
(name clerk_driver)
|
||||
(public_name clerk.driver)
|
||||
(libraries catala.runtime catala.utils ninja_utils cmdliner re ANSITerminal)
|
||||
(modules clerk_driver))
|
||||
|
||||
(executable
|
||||
(name clerk)
|
||||
(public_name clerk)
|
||||
(libraries clerk.driver)
|
||||
(modules clerk)
|
||||
(package clerk))
|
||||
|
11
build_system/tests/clerk_driver.ml
Normal file
11
build_system/tests/clerk_driver.ml
Normal file
@ -0,0 +1,11 @@
|
||||
module To_test = struct
|
||||
let catala_backend_to_string = Clerk_driver.catala_backend_to_string
|
||||
end
|
||||
|
||||
let test_catala_backend_to_string () =
|
||||
Alcotest.(check string) "same string" "Dcalc" (To_test.catala_backend_to_string Utils.Cli.Dcalc)
|
||||
|
||||
let () =
|
||||
let open Alcotest in
|
||||
run "Clerk"
|
||||
[ ("catala_backend_to_string", [ test_case "Dcalc" `Quick test_catala_backend_to_string ]) ]
|
3
build_system/tests/dune
Normal file
3
build_system/tests/dune
Normal file
@ -0,0 +1,3 @@
|
||||
(tests
|
||||
(names clerk_driver)
|
||||
(libraries alcotest clerk.driver catala.utils))
|
38
clerk.opam
Normal file
38
clerk.opam
Normal file
@ -0,0 +1,38 @@
|
||||
# This file is generated by dune, edit dune-project instead
|
||||
opam-version: "2.0"
|
||||
version: "0.5.0"
|
||||
synopsis: """
|
||||
Build system for Catala, a specification language for tax and social
|
||||
benefits computation rules"""
|
||||
description: """
|
||||
Clerk is a build system for Catala, a specification language for tax and social
|
||||
benefits computation rules, see https://catala-lang.org"""
|
||||
maintainer: ["contact@catala-lang.org"]
|
||||
authors: ["Emile Rolley" "Denis Merigoux"]
|
||||
license: "Apache-2.0"
|
||||
homepage: "https://github.com/CatalaLang/catala"
|
||||
bug-reports: "https://github.com/CatalaLang/catala/issues"
|
||||
depends: [
|
||||
"dune" {>= "2.8"}
|
||||
"ocaml" {>= "4.11.0"}
|
||||
"cmdliner" {= "1.0.4"}
|
||||
"re" {>= "1.9.0"}
|
||||
"ANSITerminal" {>= "0.8.2"}
|
||||
"catala" {= version}
|
||||
"odoc" {with-doc}
|
||||
]
|
||||
build: [
|
||||
["dune" "subst"] {dev}
|
||||
[
|
||||
"dune"
|
||||
"build"
|
||||
"-p"
|
||||
name
|
||||
"-j"
|
||||
jobs
|
||||
"@install"
|
||||
"@runtest" {with-test}
|
||||
"@doc" {with-doc}
|
||||
]
|
||||
]
|
||||
dev-repo: "git+https://github.com/CatalaLang/catala.git"
|
25
dune-project
25
dune-project
@ -94,6 +94,27 @@
|
||||
(= :version))
|
||||
(conf-npm :dev)))
|
||||
|
||||
(package
|
||||
(name clerk)
|
||||
(authors "Emile Rolley" "Denis Merigoux")
|
||||
(synopsis
|
||||
"Build system for Catala, a specification language for tax and social
|
||||
benefits computation rules")
|
||||
(description
|
||||
"Clerk is a build system for Catala, a specification language for tax and social
|
||||
benefits computation rules, see https://catala-lang.org")
|
||||
(depends
|
||||
(ocaml
|
||||
(>= 4.11.0))
|
||||
(cmdliner
|
||||
(= 1.0.4))
|
||||
(re
|
||||
(>= 1.9.0))
|
||||
(ANSITerminal
|
||||
(>= 0.8.2))
|
||||
(catala
|
||||
(= :version))))
|
||||
|
||||
(package
|
||||
(name ninja_utils)
|
||||
(authors "Emile Rolley")
|
||||
@ -108,8 +129,6 @@
|
||||
(ocaml
|
||||
(>= 4.11.0))
|
||||
(re
|
||||
(>= 1.10.3))
|
||||
(catala
|
||||
(= :version))))
|
||||
(>= 1.10.3))))
|
||||
|
||||
(using menhir 2.1)
|
||||
|
@ -17,7 +17,6 @@ depends: [
|
||||
"dune" {>= "2.8"}
|
||||
"ocaml" {>= "4.11.0"}
|
||||
"re" {>= "1.10.3"}
|
||||
"catala" {= version}
|
||||
"odoc" {with-doc}
|
||||
]
|
||||
build: [
|
||||
|
Loading…
Reference in New Issue
Block a user