Support parsing build command arguments

Summary:
This diff adds basic support for parsing the arguments passed to the
build command directly from Config.

Reviewed By: dulmarod

Differential Revision: D4201480

fbshipit-source-id: bba6056

infer/src/backend/InferPrint.re

@@ -1219,7 +1219,7 @@ let module AnalysisResults = {
     if (Config.anon_args == []) {
       load_specfiles ()
     } else {
-      Config.anon_args
+      List.rev Config.anon_args
     }
   };
 

infer/src/backend/infer.ml

@@ -181,49 +181,50 @@ let capture build_cmd = function
       L.stdout "Capturing in %s mode...@." (string_of_build_mode build_mode);
       let in_buck_mode = build_mode = Buck in
       let infer_py = Config.lib_dir ^/ "python" ^/ "infer.py" in
-      run_command
-        ~prog:infer_py ~args:(
-        Config.anon_args @
-        ["--analyzer";
-         IList.assoc (=) Config.analyzer
-           (IList.map (fun (n,a) -> (a,n)) Config.string_to_analyzer)] @
-        (match Config.blacklist with
-         | Some s when in_buck_mode -> ["--blacklist-regex"; s]
-         | _ -> []) @
-        (if not Config.create_harness then [] else
-           ["--android-harness"]) @
-        (if not Config.buck then [] else
-           ["--buck"]) @
-        (match Config.java_jar_compiler with None -> [] | Some p ->
-            ["--java-jar-compiler"; p]) @
-        (match IList.rev Config.buck_build_args with
-         | args when in_buck_mode ->
-             IList.map (fun arg -> ["--Xbuck"; "'" ^ arg ^ "'"]) args |> IList.flatten
-         | _ -> []) @
-        (if not Config.debug_mode then [] else
-           ["--debug"]) @
-        (if not Config.debug_exceptions then [] else
-           ["--debug-exceptions"]) @
-        (if Config.filtering then [] else
-           ["--no-filtering"]) @
-        (if not Config.flavors || not in_buck_mode then [] else
-           ["--use-flavors"]) @
-        "-j" :: (string_of_int Config.jobs) ::
-        (match Config.load_average with None -> [] | Some l ->
-            ["-l"; string_of_float l]) @
-        (if not Config.pmd_xml then [] else
-           ["--pmd-xml"]) @
-        ["--project-root"; Config.project_root] @
-        (if not Config.reactive_mode then [] else
-           ["--reactive"]) @
-        "--out" :: Config.results_dir ::
-        (match Config.xcode_developer_dir with None -> [] | Some d ->
-            ["--xcode-developer-dir"; d]) @
-        ("--" :: build_cmd)
-      ) (fun status ->
-          if status = Result.Error (`Exit_non_zero Config.infer_py_argparse_error_exit_code) then
-            (* swallow infer.py argument parsing error *)
-            Config.print_usage_exit ()
+      let args =
+        List.rev_append Config.anon_args (
+          ["--analyzer";
+           IList.assoc (=) Config.analyzer
+             (IList.map (fun (n,a) -> (a,n)) Config.string_to_analyzer)] @
+          (match Config.blacklist with
+           | Some s when in_buck_mode -> ["--blacklist-regex"; s]
+           | _ -> []) @
+          (if not Config.create_harness then [] else
+             ["--android-harness"]) @
+          (if not Config.buck then [] else
+             ["--buck"]) @
+          (match Config.java_jar_compiler with None -> [] | Some p ->
+              ["--java-jar-compiler"; p]) @
+          (match IList.rev Config.buck_build_args with
+           | args when in_buck_mode ->
+               IList.map (fun arg -> ["--Xbuck"; "'" ^ arg ^ "'"]) args |> IList.flatten
+           | _ -> []) @
+          (if not Config.debug_mode then [] else
+             ["--debug"]) @
+          (if not Config.debug_exceptions then [] else
+             ["--debug-exceptions"]) @
+          (if Config.filtering then [] else
+             ["--no-filtering"]) @
+          (if not Config.flavors || not in_buck_mode then [] else
+             ["--use-flavors"]) @
+          "-j" :: (string_of_int Config.jobs) ::
+          (match Config.load_average with None -> [] | Some l ->
+              ["-l"; string_of_float l]) @
+          (if not Config.pmd_xml then [] else
+             ["--pmd-xml"]) @
+          ["--project-root"; Config.project_root] @
+          (if not Config.reactive_mode then [] else
+             ["--reactive"]) @
+          "--out" :: Config.results_dir ::
+          (match Config.xcode_developer_dir with None -> [] | Some d ->
+              ["--xcode-developer-dir"; d]) @
+          ("--" :: build_cmd)
+        ) in
+      run_command ~prog:infer_py ~args
+        (fun status ->
+           if status = Result.Error (`Exit_non_zero Config.infer_py_argparse_error_exit_code) then
+             (* swallow infer.py argument parsing error *)
+             Config.print_usage_exit ()
         )
 
 let run_parallel_analysis () =

infer/src/base/CommandLineOption.ml

@@ -224,9 +224,13 @@ let mk ?(deprecated=[]) ?(exes=[])
 
 (* arguments passed to Arg.parse_argv_dynamic, susceptible to be modified on the fly when parsing *)
 let args_to_parse : string array ref = ref (Array.of_list [])
+
 (* reference used by Arg.parse_argv_dynamic to track the index of the argument being parsed *)
 let arg_being_parsed : int ref = ref 0
 
+(* list of arg specifications currently being used by Arg.parse_argv_dynamic *)
+let curr_speclist : (Arg.key * Arg.spec * Arg.doc) list ref = ref []
+
 type 'a t =
   ?deprecated:string list -> long:Arg.key -> ?short:Arg.key ->
   ?exes:exe list -> ?meta:string -> Arg.doc ->
@@ -439,6 +443,21 @@ let mk_rest ?(exes=[]) doc =
   add exes {long = "--"; short = ""; meta = ""; doc; spec; decode_json = fun _ -> []} ;
   rest
 
+let accept_unknown_args = ref false
+
+let mk_subcommand ?(exes=[]) doc command_to_speclist =
+  let rest = ref [] in
+  let spec =
+    Arg.String (fun arg ->
+        rest := List.rev (Array.to_list (Array.slice !args_to_parse (!arg_being_parsed + 1) 0)) ;
+        accept_unknown_args := true ;
+        anon_fun := (fun _ -> ()) ;
+        curr_speclist := command_to_speclist arg
+      ) in
+  add exes {long = "--"; short = ""; meta = ""; doc; spec; decode_json = fun _ -> []} ;
+  rest
+
+
 let decode_inferconfig_to_argv current_exe path =
   let json = match Utils.read_optional_json_file path with
     | Ok json ->
@@ -501,8 +520,7 @@ let prefix_before_rest args =
 let args_env_var = "INFER_ARGS"
 
 let parse ?(incomplete=false) ?(accept_unknown=false) ?config_file current_exe exe_usage =
-  let curr_speclist = ref []
-  and full_speclist = ref []
+  let full_speclist = ref []
   in
   let usage_msg = exe_usage current_exe
   in
@@ -619,16 +637,15 @@ let parse ?(incomplete=false) ?(accept_unknown=false) ?config_file current_exe e
   args_to_parse := Array.of_list (exe_name :: all_args);
   arg_being_parsed := 0;
   (* tests if msg indicates an unknown option, as opposed to a known option with bad argument *)
-  let is_unknown msg =
-    let prefix = exe_name ^ ": unknown option" in
-    prefix = (String.sub msg ~pos:0 ~len:(String.length prefix)) in
+  let is_unknown msg = String.is_substring msg ~substring:": unknown option" in
+  accept_unknown_args := accept_unknown ;
   let rec parse_loop () =
     try
-      Arg.parse_argv_dynamic ~current:arg_being_parsed !args_to_parse curr_speclist !anon_fun
-        usage_msg
+      Arg.parse_argv_dynamic ~current:arg_being_parsed !args_to_parse curr_speclist
+        (fun arg -> !anon_fun arg) usage_msg
     with
     | Arg.Bad _ when incomplete -> parse_loop ()
-    | Arg.Bad msg when accept_unknown && is_unknown msg ->
+    | Arg.Bad msg when !accept_unknown_args && is_unknown msg ->
         !anon_fun !args_to_parse.(!arg_being_parsed);
         parse_loop ()
     | Arg.Bad usage_msg -> Pervasives.prerr_string usage_msg; exit 2

infer/src/base/CommandLineOption.mli

@@ -116,6 +116,17 @@ val mk_rest :
   ?exes:exe list -> string ->
   string list ref
 
+(** [mk_subcommand doc command_to_speclist] defines a [string list ref] of the command line
+    arguments following ["--"], in the reverse order they appeared on the command line.  For
+    example, calling [mk_subcommand] and parsing [exe -opt1 -opt2 -- arg1 arg2] will result in the
+    returned ref containing [arg2; arg1].  Additionally, the first arg following ["--"] is passed to
+    [command_to_speclist] to obtain a list of argument action specifications used when parsing the
+    remaining arguments. *)
+val mk_subcommand :
+  ?exes:exe list -> string ->
+  (string -> (Arg.key * Arg.spec * Arg.doc) list) ->
+  string list ref
+
 (** environment variable use to pass arguments from parent to child processes *)
 val args_env_var : string
 

infer/src/base/Config.ml

@@ -479,11 +479,6 @@ let inferconfig_path =
 let anon_args =
   CLOpt.mk_anon ()
 
-and rest =
-  CLOpt.mk_rest
-    ~exes:CLOpt.[Toplevel]
-    "Stop argument processing, use remaining arguments as a build command"
-
 and abs_struct =
   CLOpt.mk_int ~deprecated:["absstruct"] ~long:"abs-struct" ~default:1
     ~meta:"int" "Specify abstraction level for fields of structs:\n\
@@ -1340,6 +1335,17 @@ and xml_specs =
   CLOpt.mk_bool ~deprecated:["xml"] ~long:"xml-specs"
     "Export specs into XML files file1.xml ... filen.xml"
 
+(* The "rest" args must appear after "--" on the command line, and hence after other args, so they
+   are allowed to refer to the other arg variables. *)
+let rest =
+  CLOpt.mk_subcommand
+    ~exes:CLOpt.[Toplevel]
+    "Stop argument processing, use remaining arguments as a build command"
+    (fun build_exe ->
+       match Filename.basename build_exe with
+       | _ -> []
+    )
+
 
 (** Parse Command Line Args *)
 
@@ -1428,7 +1434,7 @@ let print_usage_exit () =
 
 (** Freeze initialized configuration values *)
 
-let anon_args = IList.rev !anon_args
+let anon_args = !anon_args
 and rest = !rest
 and abs_struct = !abs_struct
 and abs_val_orig = !abs_val

infer/src/integration/CaptureCompilationDatabase.ml

@@ -93,7 +93,7 @@ let run_compilation_database compilation_database should_capture_file =
 
 (** Computes the compilation database files. *)
 let get_compilation_database_files_buck () =
-  let cmd = IList.rev_append Config.rest (IList.rev Config.buck_build_args) in
+  let cmd = List.rev_append Config.rest (IList.rev Config.buck_build_args) in
   match cmd with
   | buck :: build :: args ->
       (check_args_for_targets args;
@@ -123,7 +123,7 @@ let get_compilation_database_files_buck () =
 
 (** Compute the compilation database files. *)
 let get_compilation_database_files_xcodebuild () =
-  let prog_args = IList.rev Config.rest in
+  let prog_args = List.rev Config.rest in
   let temp_dir = Config.results_dir ^/ "clang" in
   Utils.create_dir temp_dir;
   let tmp_file = Filename.temp_file ~in_dir:temp_dir "cdb" ".json" in