(* 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 , Emile Rolley , Louis Gesbert 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,--closure) for \ $(b,--closure-conversion))\n\ NOTE: if this is set, all inline tests that are $(i,not) \ $(b,catala test-scope) are skipped to avoid redundant testing.") let runtest_report = Arg.( value & opt (some string) None & info ["report"] ~docv:"FILE" ~doc: "If set, $(i,clerk runtest) will output a tests result summary in \ binary format to the given $(b,FILE)") let runtest_out = Arg.( value & pos 1 (some string) None & info [] ~docv:"OUTFILE" ~doc:"Write the test outcome to file $(b,OUTFILE) instead of stdout.") module Global : sig val color : Catala_utils.Global.when_enum Term.t val debug : bool Term.t val term : (config_file: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 config_file = Arg.( value & opt (some file) None & info ["config"] ~docv:"FILE" ~doc: "Clerk configuration file to use, instead of looking up \ \"clerk.toml\" in parent directories.") 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,/clerk.ninja) in debug mode, and a temporary file \ otherwise") let term f = Term.( const (fun config_file catala_exe catala_opts build_dir include_dirs color debug ninja_output -> f ~config_file ~catala_exe ~catala_opts ~build_dir ~include_dirs ~color ~debug ~ninja_output) $ config_file $ 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 files = Arg.( value & pos_all file [] & info [] ~docv:"FILE(S)" ~doc:"File(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 report_verbosity = Arg.( value & vflag `Failures [ ( `Summary, info ["summary"] ~doc:"Only display a summary of the test results" ); ( `Short, info ["short"] ~doc:"Don't display detailed test failures diff" ); ( `Failures, info ["failures"] ~doc:"Show details of files with failed tests only" ); ( `Verbose, info ["verbose"; "v"] ~doc:"Display the full list of tests that have been run" ); ]) let report_xml = Arg.( value & flag & info ["xml"] ~env:(Cmd.Env.info "CATALA_XML_REPORT") ~doc:"Output the test report in JUnit-compatible XML format") let diff_command = Arg.( value & opt ~vopt:(Some None) (some (some string)) None & info ["diff"] ~env:(Cmd.Env.info "CATALA_DIFF_COMMAND") ~doc: "Use a standard $(i,diff) command instead of the default \ side-by-side view. If no argument is supplied, the command will \ be $(b,patdiff) if available or $(b,diff) otherwise. A supplied \ argument will be used as diff command with arguments pointing to \ the reference file and the output file") 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 "; `P "Emile Rolley "; `P "Louis Gesbert "; `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 (** This module is sensitive to the CWD at first use. Therefore it's expected that [chdir] has been run beforehand to the project root. *) let root = lazy (Sys.getcwd ()) (** Scans for a parent directory being the root of the Catala source repo *) let catala_project_root : File.t option Lazy.t = root |> Lazy.map @@ fun root -> if File.(exists (root / "catala.opam") && exists (root / "dune-project")) then Some root else 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 catala_project_root with | (lazy (Some root)) -> Unix.realpath File.(root / "_build" / "default" / "compiler" / "catala.exe") | _ -> File.check_exec "catala") let build_dir : dir:File.t -> unit -> File.t = fun ~dir () -> 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 @{%s@}." dir; dir | None -> Message.error "@[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)) end (**{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" (** 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 ( ! ) = 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 | "-O" | "--optimize" | "--closure-conversion" -> true | _ -> false) test_flags in let catala_flags_python = List.filter (function | "-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); ] let[@ocamlformat "disable"] static_base_rules = let open Var in let shellout l = Format.sprintf "$$(%s)" (String.concat " " l) in [ Nj.rule "copy" ~command:["cp"; "-f"; !input; !output] ~description:[""; !input]; Nj.rule "catala-ocaml" ~command:[!catala_exe; "ocaml"; !catala_flags; !catala_flags_ocaml; !input; "-o"; !output] ~description:[""; "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:[""; "⇒"; !output]; Nj.rule "ocaml-module" ~command: [!ocamlopt_exe; "-shared"; !ocaml_flags; !input; "-o"; !output] ~description:[""; "⇒"; !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:[""; "⇒"; !output]; Nj.rule "python" ~command:[!catala_exe; "python"; !catala_flags; !catala_flags_python; !input; "-o"; !output] ~description:[""; "python"; "⇒"; !output]; Nj.rule "tests" ~command: [!clerk_exe; "runtest"; !clerk_flags; !input; "--report"; !output;] ~description:[""; "tests"; "⇐"; !input]; Nj.rule "interpret" ~command: [!catala_exe; "interpret"; !catala_flags; !input; "--scope=" ^ !scope] ~description:[""; "interpret"; !scope; "⇐"; !input] ~vars:[pool, ["console"]]; Nj.rule "dir-tests" ~command:["cat"; !input; ">"; !output; ";"] ~description:[""; !test_id]; ] 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"; "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 out_tests_references = List.map (fun test -> legacy_test_reference test) item.legacy_tests in let out_tests_prepare = List.map (fun f -> Nj.build "copy" ~inputs:[f] ~outputs:[inc f]) out_tests_references in let tests = if (not item.has_inline_tests) && item.legacy_tests = [] then [] else [ Nj.build "tests" ~inputs:[inc srcv] ~implicit_in: ((!Var.clerk_exe :: interp_deps) @ List.map inc out_tests_references) ~outputs:[inc srcv ^ "@test"; inc srcv ^ "@out"] ~implicit_out: (List.map (fun o -> inc o ^ "@out") out_tests_references); ] in out_tests_prepare @ 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]]; ] 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 ( @+ ) = 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} *) (* Last argument is a continuation taking as arguments [build_dir], the [fix_path] function, and the ninja file name *) let ninja_init ~config_file ~catala_exe ~catala_opts ~build_dir ~include_dirs ~color ~debug ~ninja_output : extra:def Seq.t -> test_flags:string list -> (File.t -> (File.t -> File.t) -> File.t -> 'a) -> 'a = let _options = Catala_utils.Global.enforce_options ~debug ~color () in let default_config_file = "clerk.toml" in let set_root_dir dir = Message.debug "Entering directory %a" File.format dir; Sys.chdir dir in (* fix_path adjusts paths specified from the command-line relative to the user cwd to be instead relative to the project root *) let fix_path, config = let from_dir = Sys.getcwd () in match config_file with | None -> ( match File.(find_in_parents (fun dir -> exists (dir / default_config_file))) with | Some (root, rel) -> set_root_dir root; ( Catala_utils.File.reverse_path ~from_dir ~to_dir:rel, Clerk_config.read default_config_file ) | None -> ( match File.( find_in_parents (function dir -> exists (dir / "catala.opam") || exists (dir / ".git"))) with | Some (root, rel) -> set_root_dir root; ( Catala_utils.File.reverse_path ~from_dir ~to_dir:rel, Clerk_config.default ) | None -> Fun.id, Clerk_config.default)) | Some f -> let root = Filename.dirname f in let config = Clerk_config.read f in set_root_dir root; ( (fun d -> let r = Catala_utils.File.reverse_path ~from_dir ~to_dir:root d in Message.debug "%a => %a" File.format d File.format r; r), config ) in let build_dir = let dir = match build_dir with None -> config.build_dir | Some dir -> dir in Poll.build_dir ~dir () in let catala_opts = config.catala_opts @ catala_opts in let include_dirs = config.include_dirs @ include_dirs 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..."; let build_dir = match test_flags with | [] -> build_dir | flags -> File.((build_dir / "test") ^ String.concat "" flags) in 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 build_dir fix_path 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 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 _build_dir fix_path 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); raise (Catala_utils.Cli.Exit_with (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 set_report_verbosity = function | `Summary -> Clerk_report.set_display_flags ~files:`None ~tests:`None () | `Short -> Clerk_report.set_display_flags ~files:`Failed ~tests:`Failed ~diffs:false () | `Failures -> if Global.options.debug then Clerk_report.set_display_flags ~files:`All () | `Verbose -> Clerk_report.set_display_flags ~files:`All ~tests:`All () let test_cmd = let run ninja_init (files_or_folders : string list) (reset_test_outputs : bool) (test_flags : string list) verbosity xml (diff_command : string option option) (ninja_flags : string list) = set_report_verbosity verbosity; Clerk_report.set_display_flags ~diff_command (); ninja_init ~extra:Seq.empty ~test_flags @@ fun build_dir fix_path nin_file -> let targets = let fs = if files_or_folders = [] then ["."] else files_or_folders in List.map File.(fun f -> (build_dir / fix_path f) ^ "@test") fs in let ninja_cmd = ninja_cmdline ninja_flags nin_file targets in Message.debug "executing '%s'..." (String.concat " " ninja_cmd); match run_ninja ~clean_up_env:true ninja_cmd with | 0 -> Message.debug "gathering test results..."; let open Clerk_report in let reports = List.flatten (List.map read_many targets) in if reset_test_outputs then let () = if xml then Message.error "Options @{--xml@} and @{--reset@} are incompatible"; let ppf = Message.formatter_of_out_channel stdout () in match List.filter (fun f -> f.successful < f.total) reports with | [] -> Format.fprintf ppf "[@{DONE@}] All tests passed, nothing to reset@." | need_reset -> List.iter (fun f -> let files = List.fold_left (fun files t -> if t.success then files else File.Map.add (fst t.result).Lexing.pos_fname (String.remove_prefix ~prefix:File.(build_dir / "") (fst t.expected).Lexing.pos_fname) files) File.Map.empty f.tests in File.Map.iter (fun result expected -> Format.kasprintf Sys.command "cp -f %a %a@." File.format result File.format expected |> ignore) files) need_reset; Format.fprintf ppf "[@{DONE@}] @{%d@} test files were \ @{RESET@}@." (List.length need_reset) in raise (Catala_utils.Cli.Exit_with 0) else if (if xml then print_xml else summary) ~build_dir reports then raise (Catala_utils.Cli.Exit_with 0) else raise (Catala_utils.Cli.Exit_with 1) | 1 -> raise (Catala_utils.Cli.Exit_with 10) (* Ninja build failed *) | err -> raise (Catala_utils.Cli.Exit_with err) (* Other Ninja error ? *) 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.report_verbosity $ Cli.report_xml $ Cli.diff_command $ 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 _build_dir _fix_path nin_file -> let ninja_cmd = ninja_cmdline ninja_flags nin_file [] in Message.debug "executing '%s'..." (String.concat " " ninja_cmd); raise (Catala_utils.Cli.Exit_with (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 report out file = let catala_opts = List.fold_left (fun opts dir -> "-I" :: dir :: opts) catala_opts include_dirs in Clerk_runtest.run_tests ~catala_exe:(Option.value ~default:"catala" catala_exe) ~catala_opts ~test_flags ~report ~out 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.runtest_report $ Cli.runtest_out $ Cli.single_file) let report_cmd = let run color debug verbosity xml diff_command build_dir files = let _options = Catala_utils.Global.enforce_options ~debug ~color () in let build_dir = Option.value ~default:"_build" build_dir in set_report_verbosity verbosity; Clerk_report.set_display_flags ~diff_command (); let open Clerk_report in let tests = List.flatten (List.map read_many files) in let success = (if xml then print_xml else summary) ~build_dir tests in exit (if success then 0 else 1) in let doc = "Mainly for internal purposes. Reads a test report file and displays a \ summary of the results, returning 0 on success and 1 if any test failed." in Cmd.v (Cmd.info ~doc "report") Term.( const run $ Cli.Global.color $ Cli.Global.debug $ Cli.report_verbosity $ Cli.report_xml $ Cli.diff_command $ Cli.build_dir $ Cli.files) let main_cmd = Cmd.group Cli.info [build_cmd; test_cmd; run_cmd; runtest_cmd; report_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