More uniform and explicit treatment of program and arguments

Reviewed By: jvillard

Differential Revision: D4232430

fbshipit-source-id: e83d9fb

infer/src/backend/infer.ml

@@ -125,7 +125,7 @@ let touch_start_file () =
   with Unix.Unix_error (Unix.EEXIST, _, _) -> ()
 
 
-let run_command prog args after_wait =
+let run_command ~prog ~args after_wait =
   let open! Core.Std in
   let status = Unix.waitpid (Unix.fork_exec ~prog ~args:(prog :: args) ()) in
   after_wait status ;
@@ -174,7 +174,7 @@ let capture build_cmd = function
   | Genrule ->
       L.stdout "Capturing for Buck genrule compatibility...@\n";
       let infer_java = Config.bin_dir // "InferJava" in
-      run_command infer_java [] (fun _ -> ())
+      run_command ~prog:infer_java ~args:[] (fun _ -> ())
   | Xcode when Config.xcpretty ->
       L.stdout "Capturing using xcpretty...@\n";
       check_xcpretty ();
@@ -185,7 +185,7 @@ let capture build_cmd = function
       let in_buck_mode = build_mode = Buck in
       let infer_py = Config.lib_dir // "python" // "infer.py" in
       run_command
-        infer_py (
+        ~prog:infer_py ~args:(
         Config.anon_args @
         ["--analyzer";
          IList.assoc (=) Config.analyzer
@@ -238,7 +238,7 @@ let run_parallel_analysis () =
   let cwd = Unix.getcwd () in
   Unix.chdir multicore_dir ;
   run_command
-    "make" (
+    ~prog:"make" ~args:(
     "-k" ::
     "-j" :: (string_of_int Config.jobs) ::
     (Option.map_default (fun l -> ["-l"; string_of_float l]) [] Config.load_average) @

infer/src/base/Process.ml

@@ -29,23 +29,24 @@ let print_error_and_exit ?(exit_code=1) fmt =
     Format.str_formatter fmt
 
 (** Executes a command and catches a potential exception and prints it. *)
-let exec_command cmd args env =
+let exec_command ~prog ~args env =
-  try Unix.execve cmd args env
+  try Unix.execve prog (Array.of_list (prog :: args)) env
   with (Unix.Unix_error _ as e) ->
-    print_unix_error cmd e
+    print_unix_error (String.concat ~sep:" " (prog :: args)) e
 
 (** Given a command to be executed, create a process to execute this command, and wait for it to
     terminate. The standard out and error are not redirected.  If the command fails to execute,
     print an error message and exit. *)
-let create_process_and_wait cmd =
+let create_process_and_wait ~prog ~args =
-  let pid = Unix.create_process cmd.(0) cmd Unix.stdin Unix.stdout Unix.stderr in
+  let pid =
+    Unix.create_process prog (Array.of_list (prog :: args)) Unix.stdin Unix.stdout Unix.stderr in
   let _, status = Unix.waitpid [] pid in
   let exit_code = match status with
     | Unix.WEXITED i -> i
     | _ -> 1 in
   if exit_code <> 0 then
     print_error_and_exit ~exit_code:exit_code
-      "Failed to execute: %s\n" (String.concat ~sep:" " (Array.to_list cmd))
+      "Failed to execute: %s\n" (String.concat ~sep:" " (prog :: args))
 
 (** Given a process id and a function that describes the command that the process id
     represents, prints a message explaining the command and its status, if in debug or stats mode.
@@ -86,28 +87,27 @@ let pid_to_program jobsMap pid =
     IntMap.find pid jobsMap
   with Not_found -> ""
 
-(** [run_jobs_in_parallel jobs_stack gen_cmd cmd_to_string] runs the jobs in the given stack, by
+(** [run_jobs_in_parallel jobs_stack gen_prog prog_to_string] runs the jobs in the given stack, by
     spawning the jobs in batches of n, where n is [Config.jobs]. It then waits for all those jobs
-    and starts a new batch and so on. [gen_cmd] should return a tuple [(dir_opt, command, args,
+    and starts a new batch and so on. [gen_prog] should return a tuple [(dir_opt, command, args,
-    env)] where [dir_opt] is an optional directory to chdir to before executing the process, and
+    env)] where [dir_opt] is an optional directory to chdir to before executing [command] with
-    [command], [args], [env] are the same as for [exec_command]. [cmd_to_string] is used for
+    [args] in [env]. [prog_to_string] is used for printing information about the job's status. *)
-    printing information about the job's status. *)
+let run_jobs_in_parallel jobs_stack gen_prog prog_to_string =
-let run_jobs_in_parallel jobs_stack gen_cmd cmd_to_string =
   let run_job () =
     let jobs_map = ref IntMap.empty in
     let current_jobs_count = start_current_jobs_count () in
     while not (Stack.is_empty jobs_stack) do
-      let job_cmd = Stack.pop jobs_stack in
+      let job_prog = Stack.pop jobs_stack in
-      let (dir_opt, cmd, args, env) = gen_cmd job_cmd in
+      let (dir_opt, prog, args, env) = gen_prog job_prog in
       Pervasives.incr current_jobs_count;
       match Unix.fork () with
       | 0 ->
           (match dir_opt with
            | Some dir -> Unix.chdir dir
            | None -> ());
-          exec_command cmd args env
+          exec_command ~prog ~args env
       | pid_child ->
-          jobs_map := IntMap.add pid_child (cmd_to_string job_cmd) !jobs_map;
+          jobs_map := IntMap.add pid_child (prog_to_string job_prog) !jobs_map;
           if Stack.length jobs_stack = 0 || !current_jobs_count >= Config.jobs then
             wait_for_child (pid_to_program !jobs_map) current_jobs_count jobs_map
     done in

infer/src/base/Process.mli

@@ -12,30 +12,24 @@ open! Utils
 (** Given an command to be executed, creates a process to execute this command,
     and waits for its execution. The standard out and error are not redirected.
     If the commands fails to execute, prints an error message and exits. *)
-val create_process_and_wait : string array -> unit
+val create_process_and_wait : prog:string -> args:string list -> unit
-
-(** Given an command to be executed, creates a process to execute this command,
-    and waits for its execution. The standard out and error are not redirected.
-    If the commands fails to execute, prints an error message and exits. *)
-val exec_command : string -> string array -> string array -> unit
 
 (** Prints an error message to a log file, prints a message saying that the error can be
     found in that file, and exist, with default code 1 or a given code. *)
 val print_error_and_exit :
   ?exit_code:int -> ('a, Format.formatter, unit, 'b) format4 -> 'a
 
-(** Prints information about a unix error *)
+(** [run_jobs_in_parallel jobs_stack gen_prog prog_to_string] runs the jobs in the given stack, by
-val print_unix_error : string -> exn -> unit
-
-(** [run_jobs_in_parallel jobs_stack gen_cmd cmd_to_string] runs the jobs in the given stack, by
     spawning the jobs in batches of n, where n is [Config.jobs]. It then waits for all those jobs
-    and starts a new batch and so on. [gen_cmd] should return a tuple [(dir_opt, command, args,
+    and starts a new batch and so on. [gen_prog] should return a tuple [(dir_opt, command, args,
-    env)] where [dir_opt] is an optional directory to chdir to before executing the process, and
+    env)] where [dir_opt] is an optional directory to chdir to before executing [command] with
-    [command], [args], [env] are the same as for [exec_command]. [cmd_to_string] is used for
+    [args] in [env]. [prog_to_string] is used for printing information about the job's status. *)
-    printing information about the job's status. *)
+val run_jobs_in_parallel :
-val run_jobs_in_parallel : 'a Stack.t ->
+  'a Stack.t -> ('a -> (string option * string * string list * string array)) -> ('a -> string)
-  ('a -> (string option * string * string array * string array)) -> ('a -> string) -> unit
+  -> unit
 
 (** Pipeline producer program into consumer program *)
-val pipeline : producer_prog:string -> producer_args:string list -> consumer_prog:string ->
+val pipeline :
-  consumer_args:string list -> Core.Std.Unix.Exit_or_signal.t * Core.Std.Unix.Exit_or_signal.t
+  producer_prog:string -> producer_args:string list ->
+  consumer_prog:string -> consumer_args:string list ->
+  Core.Std.Unix.Exit_or_signal.t * Core.Std.Unix.Exit_or_signal.t

infer/src/clang/ClangCommand.re

@@ -120,12 +120,11 @@ let clang_cc1_cmd_sanitizer cmd => {
   file_arg_cmd_sanitizer {...cmd, argv: clang_arguments}
 };
 
-let mk quoting_style argv => {
+let mk quoting_style prog::prog args::args => {
-  let argv_list = Array.to_list argv;
+  exec: prog,
-  switch argv_list {
+  orig_argv: args,
-  | [exec, ...argv_no_exec] => {exec, orig_argv: argv_no_exec, argv: argv_no_exec, quoting_style}
+  argv: args,
-  | [] => failwith "argv cannot be an empty list"
+  quoting_style
-  }
 };
 
 let command_to_run cmd => {

infer/src/clang/ClangCommand.rei

@@ -9,12 +9,12 @@
 type t;
 
 
-/** [mk qs argv] finds the type of command depending on its arguments [argv]. The quoting style of
+/** [mk qs prog args] finds the type of command depending on its arguments [args]. The quoting style
-    the arguments have to be provided, so that the command may be run later on. Beware that this
+    of the arguments have to be provided, so that the command may be run later on. Beware that this
     doesn't look inside argument files. This can be used to create a "clang -### ..." command on
     which to call [command_to_run], but other functions from the module will not work as expected
     unless the command has been normalized by "clang -### ...". */
-let mk: ClangQuotes.style => array string => t;
+let mk: ClangQuotes.style => prog::string => args::list string => t;
 
 
 /** Make a command into a string ready to be passed to a shell to be executed. Fine to call with

infer/src/clang/ClangWrapper.re

@@ -1,9 +1,10 @@
-/* Copyright (c) 2016 - present Facebook, Inc.
+/*
-  * All rights reserved.
+ * Copyright (c) 2016 - present Facebook, Inc.
-  *
+ * All rights reserved.
-  * This source code is licensed under the BSD style license found in the
+ *
-  * LICENSE file in the root directory of this source tree. An additional grant
+ * This source code is licensed under the BSD style license found in the
-  * of patent rights can be found in the PATENTS file in the same directory.
+ * LICENSE file in the root directory of this source tree. An additional grant
+ * of patent rights can be found in the PATENTS file in the same directory.
  */
 
 /** Given a clang command, normalize it via `clang -###` if needed to get a clear view of what work
@@ -19,8 +20,8 @@ type action_item =
 
 /** Given a list of arguments for clang [args], return a list of new commands to run according to
     the results of `clang -### [args]`. */
-let normalize (args: array string) :list action_item => {
+let normalize prog::prog args::args :list action_item => {
-  let cmd = ClangCommand.mk ClangQuotes.SingleQuotes args;
+  let cmd = ClangCommand.mk ClangQuotes.SingleQuotes prog::prog args::args;
   let clang_hashhashhash =
     Printf.sprintf
       "%s 2>&1"
@@ -38,13 +39,17 @@ let normalize (args: array string) :list action_item => {
   let normalized_commands = ref [];
   let one_line line =>
     if (String.is_prefix prefix::" \"" line) {
-      let cmd =
+      Command (
-        /* massage line to remove edge-cases for splitting */
+        switch (
-        "\"" ^ line ^ " \"" |>
+          /* massage line to remove edge-cases for splitting */
-        /* split by whitespace */
+          "\"" ^ line ^ " \"" |>
-        Str.split (Str.regexp_string "\" \"") |> Array.of_list |>
+          /* split by whitespace */
-        ClangCommand.mk ClangQuotes.EscapedDoubleQuotes;
+          Str.split (Str.regexp_string "\" \"")
-      Command cmd
+        ) {
+        | [prog, ...args] => ClangCommand.mk ClangQuotes.EscapedDoubleQuotes prog::prog args::args
+        | [] => failwith "ClangWrapper: argv cannot be empty"
+        }
+      )
     } else if (
       Str.string_match (Str.regexp "clang[^ :]*: warning: ") line 0
     ) {
@@ -84,20 +89,20 @@ let exec_action_item =
   | ClangWarning warning => Logging.stderr "%s@\n" warning
   | Command clang_cmd => Capture.capture clang_cmd;
 
-let exe args xx_suffix => {
+let exe prog::prog args::args => {
-  /* make sure args.(0) points to clang in facebook-clang-plugins */
+  let xx_suffix = String.is_suffix suffix::"++" prog ? "++" : "";
-  args.(0) = CFrontend_config.clang_bin xx_suffix;
+  /* use clang in facebook-clang-plugins */
-  let commands = normalize args;
+  let clang_xx = CFrontend_config.clang_bin xx_suffix;
+  let commands = normalize prog::clang_xx args::args;
   /* xcodebuild projects may require the object files to be generated by the Apple compiler, eg to
      generate precompiled headers compatible with Apple's clang. */
-  let should_run_original_command =
+  let (prog, should_run_original_command) =
     switch Config.fcp_apple_clang {
     | Some bin =>
       let bin_xx = bin ^ xx_suffix;
       Logging.out "Will run Apple clang %s" bin_xx;
-      args.(0) = bin_xx;
+      (bin_xx, true)
-      true
+    | None => (clang_xx, false)
-    | None => false
     };
   IList.iter exec_action_item commands;
   if (commands == [] || should_run_original_command) {
@@ -112,8 +117,8 @@ let exe args xx_suffix => {
            files. */
       Logging.out
         "WARNING: `clang -### <args>` returned an empty set of commands to run and no error. Will run the original command directly:@\n  %s@\n"
-        (String.concat sep::" " @@ Array.to_list args)
+        (String.concat sep::" " @@ [prog, ...args])
     };
-    Process.create_process_and_wait args
+    Process.create_process_and_wait prog::prog args::args
   }
 };

infer/src/clang/ClangWrapper.rei

@@ -8,4 +8,4 @@
  */
 open! Utils;
 
-let exe: array string => string => unit;
+let exe: prog::string => args::list string => unit;

infer/src/clang/InferClang.re

@@ -8,8 +8,8 @@
  */
 open! Utils;
 
-let () = {
+let () =
-  let xx_suffix = String.is_suffix suffix::"++" Sys.argv.(0) ? "++" : "";
+  switch (Array.to_list Sys.argv) {
-  let args = Array.copy Sys.argv;
+  | [prog, ...args] => ClangWrapper.exe prog::prog args::args
-  ClangWrapper.exe args xx_suffix
+  | [] => assert false /* Sys.argv is never empty */
-};
+  };

infer/src/integration/CaptureCompilationDatabase.ml

@@ -70,7 +70,7 @@ let run_compilation_file compilation_database file =
     let arg_file =
       ClangQuotes.mk_arg_file
         "cdb_clang_args_" ClangQuotes.EscapedNoQuotes [compilation_data.args] in
-    let args = Array.of_list [wrapper_cmd; "@" ^ arg_file] in
+    let args = ["@" ^ arg_file] in
     let env =
       let env0 = Unix.environment () in
       let found = ref false in
@@ -109,9 +109,8 @@ let get_compilation_database_files_buck () =
   | buck :: build :: args ->
       (check_args_for_targets args;
        let args_with_flavor = add_flavor_to_targets args in
-       let buck_build = Array.of_list
+       let args = build :: "--config" :: "*//cxx.pch_enabled=false" :: args_with_flavor in
-           (buck :: build :: "--config" :: "*//cxx.pch_enabled=false" :: args_with_flavor) in
+       Process.create_process_and_wait ~prog:buck ~args;
-       Process.create_process_and_wait buck_build;
        let buck_targets_list = buck :: "targets" :: "--show-output" :: args_with_flavor in
        let buck_targets = String.concat ~sep:" " buck_targets_list in
        try
@@ -135,20 +134,20 @@ let get_compilation_database_files_buck () =
 
 (** Compute the compilation database files. *)
 let get_compilation_database_files_xcodebuild () =
-  let cmd_and_args = IList.rev Config.rest in
+  let prog_args = IList.rev Config.rest in
   let temp_dir = Config.results_dir // "clang" in
   create_dir temp_dir;
   let tmp_file = Filename.temp_file ~in_dir:temp_dir "cdb" ".json" in
-  let xcodebuild_cmd, xcodebuild_args =
+  let xcodebuild_prog, xcodebuild_args =
-    match cmd_and_args with
+    match prog_args with
-    | [] -> failwith("Build command cannot be empty")
+    | prog :: args -> (prog, args)
-    | cmd :: _ -> cmd, cmd_and_args in
+    | [] -> failwith("Build command cannot be empty") in
-  let xcpretty_cmd = "xcpretty" in
+  let xcpretty_prog = "xcpretty" in
-  let xcpretty_cmd_args =
+  let xcpretty_args = ["--report"; "json-compilation-database"; "--output"; tmp_file] in
-    [xcpretty_cmd; "--report"; "json-compilation-database"; "--output"; tmp_file] in
   let producer_status, consumer_status =
-    Process.pipeline ~producer_prog:xcodebuild_cmd ~producer_args:xcodebuild_args
+    Process.pipeline
-      ~consumer_prog:xcpretty_cmd ~consumer_args:xcpretty_cmd_args in
+      ~producer_prog:xcodebuild_prog ~producer_args:xcodebuild_args
+      ~consumer_prog:xcpretty_prog ~consumer_args:xcpretty_args in
   match producer_status, consumer_status with
   | Ok (), Ok () -> [tmp_file]
   | _ ->