Configurator: Export commands to run programs and capture their output

This is useful to query the environment (e.g., whether a given FORTRAN
compiler accepts some options and where is its standard library).

Signed-off-by: Christophe Troestler <Christophe.Troestler@umons.ac.be>

src/configurator/v1.ml

@@ -137,7 +137,7 @@ type run_result =
   ; stderr    : string
   }
 
-let quote =
+let quote_if_needed =
   let need_quote = function
     | ' ' | '\"' -> true
     | _          -> false
@@ -148,17 +148,28 @@ let quote =
     else s
 
 let command_line prog args =
-  String.concat ~sep:" " (List.map (prog :: args) ~f:quote)
+  String.concat ~sep:" " (List.map (prog :: args) ~f:quote_if_needed)
 
-let run t ~dir cmd =
+(* [cmd] which cannot be quoted (such as [t.c_compiler] which contains
+   some flags) followed by additional arguments. *)
+let command_args cmd args =
+  String.concat ~sep:" " (cmd :: List.map args ~f:quote_if_needed)
+
+let run_command t ?dir ?(env=[]) cmd =
   logf t "run: %s" cmd;
   let n = gen_id t in
   let stdout_fn = t.dest_dir ^/ sprintf "stdout-%d" n in
   let stderr_fn = t.dest_dir ^/ sprintf "stderr-%d" n in
+  let in_dir = match dir with
+    | None -> ""
+    | Some dir -> sprintf "cd %s && " (Filename.quote dir) in
+  let with_env = match env with
+    | [] -> ""
+    | _ -> "env " ^ String.concat ~sep:" " env in
   let exit_code =
     Printf.ksprintf
-      Sys.command "cd %s && %s > %s 2> %s"
-      (Filename.quote dir)
+      Sys.command "%s%s %s > %s 2> %s"
+      in_dir with_env
       cmd
       (Filename.quote stdout_fn)
       (Filename.quote stderr_fn)
@@ -172,16 +183,26 @@ let run t ~dir cmd =
   List.iter (String.split_lines stderr) ~f:(logf t " | %s");
   { exit_code; stdout; stderr }
 
-let run_capture_exn t ~dir cmd =
-  let { exit_code; stdout; stderr } = run t ~dir cmd in
+let run_command_capture_exn t ?dir ?env cmd =
+  let { exit_code; stdout; stderr } = run_command t ?dir ?env cmd in
   if exit_code <> 0 then
     die "command exited with code %d: %s" exit_code cmd
   else if not (String.is_empty stderr) then
     die "command has non-empty stderr: %s" cmd
   else
     stdout
 
-let run_ok t ~dir cmd = (run t ~dir cmd).exit_code = 0
+let run_command_ok t ?dir ?env cmd =
+  (run_command t ?dir ?env cmd).exit_code = 0
+
+let run t ?dir ?env prog args =
+  run_command t ?dir ?env (command_line prog args)
+
+let run_capture_exn t ?dir ?env prog args =
+ run_command_capture_exn t ?dir ?env (command_line prog args)
+
+let run_ok t ?dir ?env prog args =
+  run_command_ok t ?dir ?env (command_line prog args)
 
 let get_ocaml_config_var_exn ~ocamlc_config_cmd map var =
   match String.Map.find map var with
@@ -221,7 +242,7 @@ let create ?dest_dir ?ocamlc ?(log=ignore) name =
   in
   let ocamlc_config =
     let ocamlc_config_output =
-      run_capture_exn t ~dir:dest_dir ocamlc_config_cmd
+      run_command_capture_exn t ~dir:dest_dir ocamlc_config_cmd
       |> String.split_lines
     in
     match Ocaml_config.Vars.of_lines ocamlc_config_output with
@@ -261,11 +282,7 @@ let compile_and_link_c_prog t ?(c_flags=[]) ?(link_flags=[]) code =
   Io.write_file c_fname code;
   logf t "compiling c program:";
   List.iter (String.split_lines code) ~f:(logf t " | %s");
-  let run_ok args =
-    run_ok t ~dir
-      (String.concat ~sep:" "
-         (t.c_compiler :: List.map args ~f:Filename.quote))
-  in
+  let run_ok args = run_command_ok t ~dir (command_args t.c_compiler args) in
   let ok =
     if need_to_compile_and_link_separately t then
       run_ok (c_flags @ ["-I"; t.stdlib_dir; "-c"; c_fname])
@@ -292,19 +309,12 @@ let compile_c_prog t ?(c_flags=[]) code =
   Io.write_file c_fname code;
   logf t "compiling c program:";
   List.iter (String.split_lines code) ~f:(logf t " | %s");
-  let run_ok args =
-    run_ok t ~dir
-      (String.concat ~sep:" "
-         (t.c_compiler :: List.map args ~f:Filename.quote))
-  in
-  let ok =
-    run_ok (List.concat
-              [ c_flags
-              ; [ "-I" ; t.stdlib_dir
-                ; "-o" ; obj_fname
-                ; "-c" ; c_fname
-                ]
-              ])
+  let ok = run_command_ok t ~dir (command_args t.c_compiler
+                                    (c_flags
+                                     @ [ "-I" ; t.stdlib_dir
+                                       ; "-o" ; obj_fname
+                                       ; "-c" ; c_fname
+                                       ]))
   in
   if ok then
     Ok obj_fname
@@ -476,7 +486,7 @@ let which t prog =
   logf t "-> %s"
     (match x with
      | None -> "not found"
-     | Some fn -> "found: " ^ quote fn);
+     | Some fn -> "found: " ^ quote_if_needed fn);
   x
 
 module Pkg_config = struct
@@ -495,8 +505,8 @@ module Pkg_config = struct
     }
 
   let query t ~package =
-    let package = quote package in
-    let pkg_config = quote t.pkg_config in
+    let package = quote_if_needed package in
+    let pkg_config = quote_if_needed t.pkg_config in
     let c = t.configurator in
     let dir = c.dest_dir in
     let env =
@@ -505,20 +515,20 @@ module Pkg_config = struct
           match which c "brew" with
           | Some brew ->
             let prefix =
-              String.trim (run_capture_exn c ~dir (command_line brew ["--prefix"]))
+              String.trim (run_command_capture_exn c ~dir
+                             (command_line brew ["--prefix"]))
             in
-            sprintf "env PKG_CONFIG_PATH=$PKG_CONFIG_PATH:%s/opt/%s/lib/pkgconfig "
-              (quote prefix) package
+            [sprintf "PKG_CONFIG_PATH=$PKG_CONFIG_PATH:%s/opt/%s/lib/pkgconfig"
+               (quote_if_needed prefix) package]
           | None ->
-            ""
+            []
         end
-      | _ -> ""
+      | _ -> []
     in
-    if run_ok c ~dir (sprintf "%s%s %s" env pkg_config package) then
+    if run_ok c ~dir ~env pkg_config [package] then
       let run what =
-        match
-          String.trim
-            (run_capture_exn c ~dir (sprintf "%s%s %s %s" env pkg_config what package))
+        match String.trim
+                (run_capture_exn c ~dir ~env pkg_config [what; package])
         with
         | "" -> []
         | s  -> String.split s ~on:' '

src/configurator/v1.mli

@@ -123,6 +123,35 @@ val which : t -> string -> string option
    of the program prefixed with the first path where it is found.
    Return [None] the the program is not found. *)
 
+
+type run_result =
+  { exit_code : int
+  ; stdout    : string
+  ; stderr    : string
+  }
+
+val run : t -> ?dir:string -> ?env:string list ->
+          string -> string list -> run_result
+(** [run t prog args] runs [prog] with arguments [args] and returns
+   its exit status together with the content of stdout and stderr.
+   The action is logged.
+
+   @param dir change to [dir] before running the command.
+   @param env specify additional environment variables as a list of
+              the form NAME=VALUE. *)
+
+val run_capture_exn : t -> ?dir:string -> ?env:string list ->
+                      string -> string list -> string
+(** [run_capture_exn t prog args] same as [run t prog args] but
+   returns [stdout] and {!die} if the error code is nonzero or there
+   is some output on [stderr].  *)
+
+val run_ok : t -> ?dir:string -> ?env:string list ->
+             string -> string list -> bool
+(** [run_ok t prog args] same as [run t prog args] but only cares
+   whether the execution terminated successfully (i.e., returned an
+   error code of [0]).  *)
+
 (** Typical entry point for configurator programs *)
 val main
   :  ?args:(Arg.key * Arg.spec * Arg.doc) list