From 53c170ca0a08d2234f3d5d85a6105372d1e1b201 Mon Sep 17 00:00:00 2001 From: Josh Berdine Date: Fri, 9 Dec 2016 16:26:58 -0800 Subject: [PATCH] More uniform and explicit treatment of program and arguments Reviewed By: jvillard Differential Revision: D4232430 fbshipit-source-id: e83d9fb --- infer/src/backend/infer.ml | 8 +-- infer/src/base/Process.ml | 32 +++++------ infer/src/base/Process.mli | 30 ++++------ infer/src/clang/ClangCommand.re | 11 ++-- infer/src/clang/ClangCommand.rei | 6 +- infer/src/clang/ClangWrapper.re | 55 ++++++++++--------- infer/src/clang/ClangWrapper.rei | 2 +- infer/src/clang/InferClang.re | 10 ++-- .../integration/CaptureCompilationDatabase.ml | 27 +++++---- 9 files changed, 89 insertions(+), 92 deletions(-) diff --git a/infer/src/backend/infer.ml b/infer/src/backend/infer.ml index b8f470d98..3b99f062d 100644 --- a/infer/src/backend/infer.ml +++ b/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) @ diff --git a/infer/src/base/Process.ml b/infer/src/base/Process.ml index 15ca23145..17594653e 100644 --- a/infer/src/base/Process.ml +++ b/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 = - try Unix.execve cmd args env +let exec_command ~prog ~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 pid = Unix.create_process cmd.(0) cmd Unix.stdin Unix.stdout Unix.stderr in +let create_process_and_wait ~prog ~args = + 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, - env)] where [dir_opt] is an optional directory to chdir to before executing the process, and - [command], [args], [env] are the same as for [exec_command]. [cmd_to_string] is used for - printing information about the job's status. *) -let run_jobs_in_parallel jobs_stack gen_cmd cmd_to_string = + 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 [command] with + [args] in [env]. [prog_to_string] is used for printing information about the job's status. *) +let run_jobs_in_parallel jobs_stack gen_prog prog_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 (dir_opt, cmd, args, env) = gen_cmd job_cmd in + let job_prog = Stack.pop jobs_stack 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 diff --git a/infer/src/base/Process.mli b/infer/src/base/Process.mli index 67a16ff8d..d5e9e36ee 100644 --- a/infer/src/base/Process.mli +++ b/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 - -(** 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 +val create_process_and_wait : prog:string -> args:string list -> 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 *) -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 +(** [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, - env)] where [dir_opt] is an optional directory to chdir to before executing the process, and - [command], [args], [env] are the same as for [exec_command]. [cmd_to_string] is used for - printing information about the job's status. *) -val run_jobs_in_parallel : 'a Stack.t -> - ('a -> (string option * string * string array * string array)) -> ('a -> string) -> unit + 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 [command] with + [args] in [env]. [prog_to_string] is used for printing information about the job's status. *) +val run_jobs_in_parallel : + 'a Stack.t -> ('a -> (string option * string * string list * string array)) -> ('a -> string) + -> unit (** Pipeline producer program into consumer program *) -val pipeline : 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 +val pipeline : + 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 diff --git a/infer/src/clang/ClangCommand.re b/infer/src/clang/ClangCommand.re index 55ca8db2e..d0858b626 100644 --- a/infer/src/clang/ClangCommand.re +++ b/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 argv_list = Array.to_list argv; - switch argv_list { - | [exec, ...argv_no_exec] => {exec, orig_argv: argv_no_exec, argv: argv_no_exec, quoting_style} - | [] => failwith "argv cannot be an empty list" - } +let mk quoting_style prog::prog args::args => { + exec: prog, + orig_argv: args, + argv: args, + quoting_style }; let command_to_run cmd => { diff --git a/infer/src/clang/ClangCommand.rei b/infer/src/clang/ClangCommand.rei index 7e3769a21..1e3df1cdc 100644 --- a/infer/src/clang/ClangCommand.rei +++ b/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 - the arguments have to be provided, so that the command may be run later on. Beware that this +/** [mk qs prog args] finds the type of command depending on its arguments [args]. The quoting style + 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 diff --git a/infer/src/clang/ClangWrapper.re b/infer/src/clang/ClangWrapper.re index 1f25e9382..11dac8f73 100644 --- a/infer/src/clang/ClangWrapper.re +++ b/infer/src/clang/ClangWrapper.re @@ -1,9 +1,10 @@ -/* 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 - * of patent rights can be found in the PATENTS file in the same directory. +/* + * 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 + * 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 cmd = ClangCommand.mk ClangQuotes.SingleQuotes args; +let normalize prog::prog args::args :list action_item => { + 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 = - /* massage line to remove edge-cases for splitting */ - "\"" ^ line ^ " \"" |> - /* split by whitespace */ - Str.split (Str.regexp_string "\" \"") |> Array.of_list |> - ClangCommand.mk ClangQuotes.EscapedDoubleQuotes; - Command cmd + Command ( + switch ( + /* massage line to remove edge-cases for splitting */ + "\"" ^ line ^ " \"" |> + /* split by whitespace */ + Str.split (Str.regexp_string "\" \"") + ) { + | [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 => { - /* make sure args.(0) points to clang in facebook-clang-plugins */ - args.(0) = CFrontend_config.clang_bin xx_suffix; - let commands = normalize args; +let exe prog::prog args::args => { + let xx_suffix = String.is_suffix suffix::"++" prog ? "++" : ""; + /* use clang in facebook-clang-plugins */ + 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; - true - | None => false + (bin_xx, true) + | None => (clang_xx, 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 -### ` 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 } }; diff --git a/infer/src/clang/ClangWrapper.rei b/infer/src/clang/ClangWrapper.rei index d31180e4b..07a6c9e0b 100644 --- a/infer/src/clang/ClangWrapper.rei +++ b/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; diff --git a/infer/src/clang/InferClang.re b/infer/src/clang/InferClang.re index 03e936c8d..33529f6c6 100644 --- a/infer/src/clang/InferClang.re +++ b/infer/src/clang/InferClang.re @@ -8,8 +8,8 @@ */ open! Utils; -let () = { - let xx_suffix = String.is_suffix suffix::"++" Sys.argv.(0) ? "++" : ""; - let args = Array.copy Sys.argv; - ClangWrapper.exe args xx_suffix -}; +let () = + switch (Array.to_list Sys.argv) { + | [prog, ...args] => ClangWrapper.exe prog::prog args::args + | [] => assert false /* Sys.argv is never empty */ + }; diff --git a/infer/src/integration/CaptureCompilationDatabase.ml b/infer/src/integration/CaptureCompilationDatabase.ml index b5c4ba8e3..5d04bd7a1 100644 --- a/infer/src/integration/CaptureCompilationDatabase.ml +++ b/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 - (buck :: build :: "--config" :: "*//cxx.pch_enabled=false" :: args_with_flavor) in - Process.create_process_and_wait buck_build; + let args = build :: "--config" :: "*//cxx.pch_enabled=false" :: args_with_flavor in + Process.create_process_and_wait ~prog:buck ~args; 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 = - match cmd_and_args with - | [] -> failwith("Build command cannot be empty") - | cmd :: _ -> cmd, cmd_and_args in - let xcpretty_cmd = "xcpretty" in - let xcpretty_cmd_args = - [xcpretty_cmd; "--report"; "json-compilation-database"; "--output"; tmp_file] in + let xcodebuild_prog, xcodebuild_args = + match prog_args with + | prog :: args -> (prog, args) + | [] -> failwith("Build command cannot be empty") in + let xcpretty_prog = "xcpretty" in + let xcpretty_args = ["--report"; "json-compilation-database"; "--output"; tmp_file] in let producer_status, consumer_status = - Process.pipeline ~producer_prog:xcodebuild_cmd ~producer_args:xcodebuild_args - ~consumer_prog:xcpretty_cmd ~consumer_args:xcpretty_cmd_args in + Process.pipeline + ~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] | _ ->