diff --git a/.gitignore b/.gitignore index 8984ac8d..7c14f3f5 100644 --- a/.gitignore +++ b/.gitignore @@ -2,3 +2,4 @@ _build *.install boot.exe .merlin +boot.ml diff --git a/bootstrap.ml b/bootstrap.ml index 9a0af296..51b142c3 100644 --- a/bootstrap.ml +++ b/bootstrap.ml @@ -291,6 +291,16 @@ end let () = generate_file_with_all_the_sources () +let cleanup ~keep_ml_file = + try + Array.iter (Sys.readdir ".") ~f:(fun fn -> + if fn <> "boot.exe" && + starts_with fn ~prefix:"boot." && + (fn <> "boot.ml" || not keep_ml_file) then + Sys.remove fn) + with _ -> + () + let () = let lib_ext = match mode with @@ -298,15 +308,9 @@ let () = | Byte -> "cma" in let n = - protectx () - ~f:(fun () -> - exec "%s -w -40 -o boot.exe unix.%s %s" compiler lib_ext generated_file) - ~finally:(fun () -> - try - Array.iter (Sys.readdir ".") ~f:(fun fn -> - if fn <> "boot.exe" && starts_with fn ~prefix:"boot." then - Sys.remove fn) - with _ -> - ()) + match exec "%s -w -40 -o boot.exe unix.%s %s" compiler lib_ext generated_file with + | n -> n + | exception e -> cleanup ~keep_ml_file:true; raise e in + cleanup ~keep_ml_file:(n <> 0); if n <> 0 then exit n diff --git a/doc/manual.org b/doc/manual.org index 3dd9fd79..5826d74b 100644 --- a/doc/manual.org +++ b/doc/manual.org @@ -708,6 +708,13 @@ Jbuilder accept three kinds of pre-processing: Note that in any cases, files are pre-processed only once. Jbuilder doesn't use the =-pp= or =-ppx= of the various OCaml tools. +However, in the case of =(command )=, the shell command +is still interpreted in the same way as if it was passed to the =-pp= +option. In particular it is executed using the system shell (=sh= or +=cmd= depending on the OS). Note that you shouldn't make assumption +about where the command is run from, this is an implementation detail +of Jbuilder and might change in the Future. + == is expected to be a list where each element is either a command line flag if starting with a =-= or the name of a library implementing an OCaml AST rewriter. These must be @@ -809,8 +816,9 @@ of these two forms: - using a small DSL, that is interpreted by jbuilder directly and doesn't require an external shell -In both case, each atom in the argument supports [[Variables expansion][variables -expansion]]. Moreover, you don't need to specify dependencies +In both case, all atoms in the argument of this field supports +[[Variables + expansion][variables expansion]]. Moreover, you don't need to specify dependencies explicitely for the special =${exe:...}=, =${bin:...}= or =${findlib:...}= forms, these are recognized automatically by Jbuilder. @@ -831,8 +839,9 @@ The following constructions are available: - =(echo )= to output a string on stdout - =(cat )= to print the contents of a file to stdout - =(copy )= to copy a file -- =(copy-and-add-line-directive )= to copy a file and add a - line directive at the beginning +- =(copy-and-add-line-directive )= to copy a file and add a line directive at the beginning +- =(system )= to execute a command using the system shell: =sh= + on Unix and =cmd= on Windows * Usage diff --git a/src/action.ml b/src/action.ml index dee7eb3a..3b2b231e 100644 --- a/src/action.ml +++ b/src/action.ml @@ -11,6 +11,7 @@ module Mini_shexp = struct | Echo of 'a | Cat of 'a | Copy_and_add_line_directive of 'a * 'a + | System of 'a let rec t a sexp = sum @@ -25,6 +26,7 @@ module Mini_shexp = struct With_stdout_to (dst, Cat src)) ; cstr "copy-and-add-line-directive" (a @> a @> nil) (fun src dst -> Copy_and_add_line_directive (src, dst)) + ; cstr "system" (a @> nil) (fun cmd -> System cmd) ] sexp @@ -38,6 +40,7 @@ module Mini_shexp = struct | Echo x -> Echo (f x) | Cat x -> Cat (f x) | Copy_and_add_line_directive (x, y) -> Copy_and_add_line_directive (f x, f y) + | System x -> System (f x) let rec fold t ~init:acc ~f = match t with @@ -49,6 +52,7 @@ module Mini_shexp = struct | Echo x -> f acc x | Cat x -> f acc x | Copy_and_add_line_directive (x, y) -> f (f acc x) y + | System x -> f acc x let rec sexp_of_t f : _ -> Sexp.t = function | Run (a, xs) -> List (Atom "run" :: f a :: List.map xs ~f) @@ -60,6 +64,7 @@ module Mini_shexp = struct | Cat x -> List [Atom "cat"; f x] | Copy_and_add_line_directive (x, y) -> List [Atom "copy-and-add-line-directive"; f x; f y] + | System x -> List [Atom "system"; f x] end module T = struct diff --git a/src/build.ml b/src/build.ml index 8b7e1fe0..65552d5d 100644 --- a/src/build.ml +++ b/src/build.ml @@ -233,6 +233,15 @@ module Shexp = struct Printf.fprintf oc "# 1 %S\n" (Path.to_string fn); copy_channels ic oc)); return () + | System cmd -> + let path, arg, err = + Utils.system_shell ~needed_to:"interpret (system ...) actions" + in + match err with + | Some err -> err.fail () + | None -> + exec ~dir ~env ~env_extra ~stdout_to ~tail + (Run (Path.to_string path, [arg; cmd])) and exec_list l ~dir ~env ~env_extra ~stdout_to ~tail = match l with diff --git a/src/gen_rules.ml b/src/gen_rules.ml index 7adb32ea..d4681a16 100644 --- a/src/gen_rules.ml +++ b/src/gen_rules.ml @@ -282,6 +282,16 @@ module Gen(P : Params) = struct let bash ?dir ?stdout_to ?env ?extra_targets cmd = run (Dep (Path.absolute "/bin/bash")) ?dir ?stdout_to ?env ?extra_targets [ As ["-e"; "-u"; "-o"; "pipefail"; "-c"; cmd] ] + + let system ?dir ?stdout_to ?env ?extra_targets cmd ~needed_to = + let path, arg, fail = Utils.system_shell ~needed_to in + let build = + run (Dep path) ?dir ?stdout_to ?env ?extra_targets + [ As [arg; cmd] ] + in + match fail with + | None -> build + | Some fail -> Build.fail fail >>> build end module Alias = struct @@ -622,12 +632,14 @@ module Gen(P : Params) = struct | No_preprocessing -> m | Command cmd -> pped_module m ~dir ~f:(fun _kind src dst -> + let dir = ctx.build_dir in add_rule (preprocessor_deps >>> Build.path src >>> - Build.bash ~stdout_to:dst ~dir + Build.system ~stdout_to:dst ~dir + ~needed_to:"run preprocessor commands" (sprintf "%s %s" (expand_vars ~dir cmd) (Filename.quote (Path.reach src ~from:dir))))) | Pps { pps; flags } -> @@ -1400,7 +1412,8 @@ module Gen(P : Params) = struct let src = Path.relative dir (name ^ ".mll" ) in let dst = Path.relative dir (name ^ ".ml" ) in add_rule - (Build.run (Dep ctx.ocamllex) [A "-q"; A "-o"; Target dst; Dep src])) + (Build.run ~dir:ctx.build_dir (Dep ctx.ocamllex) + [A "-q"; A "-o"; Target dst; Dep src])) let ocamlyacc_rules (conf : Ocamlyacc.t) ~dir = List.iter conf.names ~f:(fun name -> @@ -1408,7 +1421,7 @@ module Gen(P : Params) = struct let dst = Path.relative dir (name ^ ".ml" ) in let dsti = Path.relative dir (name ^ ".mli" ) in add_rule - (Build.run ~extra_targets:[dst; dsti] + (Build.run ~extra_targets:[dst; dsti] ~dir:ctx.build_dir (Dep ctx.ocamlyacc) [ Dep src ])) diff --git a/src/utils.ml b/src/utils.ml new file mode 100644 index 00000000..ccb58a66 --- /dev/null +++ b/src/utils.ml @@ -0,0 +1,20 @@ +open Import + +let system_shell = + let cmd, arg, os = + if Sys.win32 then + ("cmd", "/c", "on Windows") + else + ("sh", "-c", "") + in + let bin = lazy (Bin.which cmd) in + fun ~needed_to -> + match Lazy.force bin with + | Some path -> (path, arg, None) + | None -> + (Path.absolute ("/" ^ cmd), + arg, + Some { fail = fun () -> + die "I need %s to %s but I couldn't find it :(\n\ + Who doesn't have %s%s??!" + cmd needed_to cmd os }) diff --git a/src/utils.mli b/src/utils.mli new file mode 100644 index 00000000..e54eba93 --- /dev/null +++ b/src/utils.mli @@ -0,0 +1,7 @@ +(** Utilities that can't go in [Import] *) + +open Import + +(** Return the absolute path to the shell, the argument to pass it (-c or /c) and a + failure in case the shell can't be found. *) +val system_shell : needed_to:string -> Path.t * string * fail option