diff --git a/infer/src/base/CommandLineOption.ml b/infer/src/base/CommandLineOption.ml index 716f37789..b673fd1c6 100644 --- a/infer/src/base/CommandLineOption.ml +++ b/infer/src/base/CommandLineOption.ml @@ -31,6 +31,9 @@ let to_arg_spec = function | Symbol (symbols, f) -> Arg.Symbol (symbols, f) | Rest f -> Arg.Rest f +let to_arg_spec_triple (x, spec, y) = (x, to_arg_spec spec, y) +let to_arg_speclist = List.map ~f:to_arg_spec_triple + let is_env_var_set v = Option.value (Option.map (Sys.getenv v) ~f:((=) "1")) ~default:false @@ -68,11 +71,37 @@ let init_work_dir, is_originator = Unix.putenv ~key:"INFER_CWD" ~data:real_cwd; (real_cwd, true) +let strict_mode = is_env_var_set "INFER_STRICT_MODE" + let warnf = - if is_env_var_set "INFER_STRICT_MODE" then failwithf + if strict_mode then failwithf else if not is_originator then fun fmt -> F.ifprintf F.err_formatter fmt else F.eprintf +type section = Analysis | Clang | Driver | Java | Print [@@deriving compare] + +let equal_section = [%compare.equal : section ] +let all_sections = [ Analysis; Clang; Driver; Java; Print ] + +type 'a parse = Infer of 'a | Javac | NoParse [@@deriving compare] + +type parse_mode = section list parse [@@deriving compare] + +type parse_action = section parse [@@deriving compare] + +let equal_parse_action = [%compare.equal : parse_action ] + +type parse_tag = unit parse [@@deriving compare] + +let equal_parse_tag = [%compare.equal : parse_tag ] +let all_parse_tags = [ Infer (); Javac; NoParse ] + +let to_parse_tag = function | Infer _ -> Infer () | Javac -> Javac | NoParse -> NoParse + +let accept_unknown_args = function + | Infer Print | Javac | NoParse -> true + | Infer Analysis | Infer Clang | Infer Driver | Infer Java -> false + type desc = { long: string; short: string; meta: string; doc: string; spec: spec; (** how to go from an option in the json config file to a list of command-line options *) @@ -217,26 +246,32 @@ let check_no_duplicates desc_list = check_for_duplicates_ (IList.sort (fun (x, _, _) (y, _, _) -> String.compare x y) desc_list) -let full_desc_list = ref [] +let parse_tag_desc_lists = List.map ~f:(fun parse_tag -> (parse_tag, ref [])) all_parse_tags -let exe_desc_lists = IList.map (fun (_, exe) -> (exe, ref [])) exes +let infer_section_desc_lists = List.map ~f:(fun section -> (section, ref [])) all_sections -(** add desc to all desc_lists for the purposes of parsing, include desc in --help only for exes *) -let add exes desc = +(** add [desc] to the one relevant parse_tag_desc_lists for the purposes of parsing, and, in the + case of Infer, include [desc] in --help only for the relevant sections. *) +let add parse_mode desc = + let tag = to_parse_tag parse_mode in + let full_desc_list = List.Assoc.find_exn parse_tag_desc_lists tag in full_desc_list := desc :: !full_desc_list ; - IList.iter (fun (exe, desc_list) -> - let desc = - if List.mem ~equal:equal_exe exes exe then - desc - else - {desc with meta = ""; doc = ""} in - desc_list := desc :: !desc_list - ) exe_desc_lists - -let deprecate_desc ~long ~short ~deprecated desc = - let warn () = - warnf "WARNING: '-%s' is deprecated. Use '--%s'%s instead.@." - deprecated long (if short = "" then "" else Printf.sprintf " or '-%s'" short) in + match parse_mode with + | Javac | NoParse -> () + | Infer sections -> + List.iter infer_section_desc_lists ~f:(fun (section, desc_list) -> + let desc = if List.mem ~equal:equal_section sections section then + desc + else + {desc with meta = ""; doc = ""} in + desc_list := desc :: !desc_list) + +let deprecate_desc parse_mode ~long ~short ~deprecated desc = + let warn () = match parse_mode with + | Javac | NoParse -> () + | Infer _ -> + warnf "WARNING: '-%s' is deprecated. Use '--%s'%s instead.@." + deprecated long (if short = "" then "" else Printf.sprintf " or '-%s'" short) in let warn_then_f f x = warn (); f x in let deprecated_spec = match desc.spec with | Unit f -> Unit (warn_then_f f) @@ -249,7 +284,7 @@ let deprecate_desc ~long ~short ~deprecated desc = { long = ""; short = deprecated; meta = ""; doc = ""; spec = deprecated_spec; decode_json = deprecated_decode_json } -let mk ?(deprecated=[]) ?(exes=[]) +let mk ?(deprecated=[]) ?(parse_mode=Infer []) ~long ?(short="") ~default ~meta doc ~default_to_string ~decode_json ~mk_setter ~mk_spec = let variable = ref default in let closure = mk_setter variable in @@ -265,16 +300,21 @@ let mk ?(deprecated=[]) ?(exes=[]) else doc ^ " (default: " ^ default_string ^ ")" in let desc = {long; short; meta; doc; spec; decode_json} in (* add desc for long option, with documentation (which includes any short option) for exes *) - add exes desc ; + if long <> "" then add parse_mode desc ; (* add desc for short option only for parsing, without documentation *) + let parse_mode_no_sections = match parse_mode with + | Infer _ -> Infer [] + | Javac | NoParse -> parse_mode in if short <> "" then - add [] {desc with long = ""; meta = ""; doc = ""} ; + add parse_mode_no_sections {desc with long = ""; meta = ""; doc = ""} ; (* add desc for deprecated options only for parsing, without documentation *) List.iter deprecated ~f:(fun deprecated -> - deprecate_desc ~long ~short ~deprecated desc - |> add []) ; + deprecate_desc parse_mode ~long ~short ~deprecated desc + |> add parse_mode_no_sections) ; variable +(* begin parsing state *) + (* 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 []) @@ -284,34 +324,47 @@ 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 [] +let unknown_args_action = ref `Reject + +let rev_anon_args = ref [] +let anon_fun arg = match !unknown_args_action with + | `Skip -> + () + | `Add -> + rev_anon_args := arg::!rev_anon_args + | `Reject -> + raise (Arg.Bad ("unexpected anonymous argument: " ^ arg)) + +(* end parsing state *) + type 'a t = ?deprecated:string list -> long:Arg.key -> ?short:Arg.key -> - ?exes:exe list -> ?meta:string -> Arg.doc -> + ?parse_mode:parse_mode -> ?meta:string -> Arg.doc -> 'a let string_json_decoder ~long json = [dashdash long; YBU.to_string json] let list_json_decoder json_decoder json = IList.flatten (YBU.convert_each json_decoder json) -let mk_set var value ?(deprecated=[]) ~long ?short ?exes ?(meta="") doc = +let mk_set var value ?(deprecated=[]) ~long ?short ?parse_mode ?(meta="") doc = let setter () = var := value in ignore( - mk ~deprecated ~long ?short ~default:() ?exes ~meta doc + mk ~deprecated ~long ?short ~default:() ?parse_mode ~meta doc ~default_to_string:(fun () -> "") ~decode_json:(string_json_decoder ~long) ~mk_setter:(fun _ _ -> setter ()) ~mk_spec:(fun _ -> Unit setter) ) let mk_option ?(default=None) ?(default_to_string=fun _ -> "") ~f - ?(deprecated=[]) ~long ?short ?exes ?(meta="") doc = - mk ~deprecated ~long ?short ~default ?exes ~meta doc + ?(deprecated=[]) ~long ?short ?parse_mode ?(meta="") doc = + mk ~deprecated ~long ?short ~default ?parse_mode ~meta doc ~default_to_string ~decode_json:(string_json_decoder ~long) ~mk_setter:(fun var str -> var := f str) ~mk_spec:(fun set -> String set) let mk_bool ?(deprecated_no=[]) ?(default=false) ?(f=fun b -> b) - ?(deprecated=[]) ~long ?short ?exes ?(meta="") doc = + ?(deprecated=[]) ~long ?short ?parse_mode ?(meta="") doc = let nolong = let len = String.length long in if len > 3 && String.sub long ~pos:0 ~len:3 = "no-" then @@ -340,13 +393,13 @@ let mk_bool ?(deprecated_no=[]) ?(default=false) ?(f=fun b -> b) let default_to_string _ = "" in let mk_spec set = Unit (fun () -> set "") in let var = - mk ~long ?short ~deprecated ~default ?exes + mk ~long ?short ~deprecated ~default ?parse_mode ~meta doc ~default_to_string ~mk_setter:(fun var _ -> var := f true) ~decode_json:(fun json -> [dashdash (if YBU.to_bool json then long else nolong)]) ~mk_spec in ignore( - mk ~long:nolong ?short:noshort ~deprecated:deprecated_no ~default:(not default) ?exes + mk ~long:nolong ?short:noshort ~deprecated:deprecated_no ~default:(not default) ?parse_mode ~meta nodoc ~default_to_string ~mk_setter:(fun _ _ -> var := f false) ~decode_json:(fun json -> [dashdash (if YBU.to_bool json then nolong else long)]) @@ -354,60 +407,61 @@ let mk_bool ?(deprecated_no=[]) ?(default=false) ?(f=fun b -> b) var let mk_bool_group ?(deprecated_no=[]) ?(default=false) - ?(deprecated=[]) ~long ?short ?exes ?(meta="") doc children no_children = + ?(deprecated=[]) ~long ?short ?parse_mode ?(meta="") doc children no_children = let f b = IList.iter (fun child -> child := b) children ; IList.iter (fun child -> child := not b) no_children ; b in - mk_bool ~deprecated ~deprecated_no ~default ~long ?short ~f ?exes ~meta doc + mk_bool ~deprecated ~deprecated_no ~default ~long ?short ~f ?parse_mode ~meta doc -let mk_int ~default ?(deprecated=[]) ~long ?short ?exes ?(meta="") doc = - mk ~deprecated ~long ?short ~default ?exes ~meta doc +let mk_int ~default ?(deprecated=[]) ~long ?short ?parse_mode ?(meta="") doc = + mk ~deprecated ~long ?short ~default ?parse_mode ~meta doc ~default_to_string:string_of_int ~mk_setter:(fun var str -> var := (int_of_string str)) ~decode_json:(string_json_decoder ~long) ~mk_spec:(fun set -> String set) -let mk_int_opt ?default ?(deprecated=[]) ~long ?short ?exes ?(meta="") doc = +let mk_int_opt ?default ?(deprecated=[]) ~long ?short ?parse_mode ?(meta="") doc = let default_to_string = function Some f -> string_of_int f | None -> "" in let f s = Some (int_of_string s) in - mk_option ~deprecated ~long ?short ~default ~default_to_string ~f ?exes ~meta doc + mk_option ~deprecated ~long ?short ~default ~default_to_string ~f ?parse_mode ~meta doc -let mk_float ~default ?(deprecated=[]) ~long ?short ?exes ?(meta="") doc = - mk ~deprecated ~long ?short ~default ?exes ~meta doc +let mk_float ~default ?(deprecated=[]) ~long ?short ?parse_mode ?(meta="") doc = + mk ~deprecated ~long ?short ~default ?parse_mode ~meta doc ~default_to_string:string_of_float ~mk_setter:(fun var str -> var := (float_of_string str)) ~decode_json:(string_json_decoder ~long) ~mk_spec:(fun set -> String set) -let mk_float_opt ?default ?(deprecated=[]) ~long ?short ?exes ?(meta="") doc = +let mk_float_opt ?default ?(deprecated=[]) ~long ?short ?parse_mode ?(meta="") doc = let default_to_string = function Some f -> string_of_float f | None -> "" in let f s = Some (float_of_string s) in - mk_option ~deprecated ~long ?short ~default ~default_to_string ~f ?exes ~meta doc + mk_option ~deprecated ~long ?short ~default ~default_to_string ~f ?parse_mode ~meta doc -let mk_string ~default ?(f=fun s -> s) ?(deprecated=[]) ~long ?short ?exes ?(meta="") doc = - mk ~deprecated ~long ?short ~default ?exes ~meta doc +let mk_string ~default ?(f=fun s -> s) ?(deprecated=[]) ~long ?short ?parse_mode ?(meta="") doc = + mk ~deprecated ~long ?short ~default ?parse_mode ~meta doc ~default_to_string:(fun s -> s) ~mk_setter:(fun var str -> var := f str) ~decode_json:(string_json_decoder ~long) ~mk_spec:(fun set -> String set) -let mk_string_opt ?default ?(f=fun s -> s) ?(deprecated=[]) ~long ?short ?exes ?(meta="") doc = +let mk_string_opt ?default ?(f=fun s -> s) ?(deprecated=[]) ~long ?short ?parse_mode + ?(meta="") doc = let default_to_string = function Some s -> s | None -> "" in let f s = Some (f s) in - mk_option ~deprecated ~long ?short ~default ~default_to_string ~f ?exes ~meta doc + mk_option ~deprecated ~long ?short ~default ~default_to_string ~f ?parse_mode ~meta doc let mk_string_list ?(default=[]) ?(f=fun s -> s) - ?(deprecated=[]) ~long ?short ?exes ?(meta="") doc = - mk ~deprecated ~long ?short ~default ?exes ~meta doc + ?(deprecated=[]) ~long ?short ?parse_mode ?(meta="") doc = + mk ~deprecated ~long ?short ~default ?parse_mode ~meta doc ~default_to_string:(String.concat ~sep:", ") ~mk_setter:(fun var str -> var := (f str) :: !var) ~decode_json:(list_json_decoder (string_json_decoder ~long)) ~mk_spec:(fun set -> String set) let mk_path_helper ~setter ~default_to_string - ~default ~deprecated ~long ~short ~exes ~meta ~decode_json doc = + ~default ~deprecated ~long ~short ~parse_mode ~meta ~decode_json doc = let normalize_path_in_args_being_parsed str = if Filename.is_relative str then ( (* Replace relative paths with absolute ones on the fly in the args being parsed. This assumes @@ -420,59 +474,60 @@ let mk_path_helper ~setter ~default_to_string abs_path ) else str in - mk ~deprecated ~long ?short ~default ?exes ~meta doc + mk ~deprecated ~long ?short ~default ?parse_mode ~meta doc ~decode_json ~default_to_string ~mk_setter:(fun var str -> let abs_path = normalize_path_in_args_being_parsed str in setter var abs_path) ~mk_spec:(fun set -> String set) -let mk_path ~default ?(deprecated=[]) ~long ?short ?exes ?(meta="path") = +let mk_path ~default ?(deprecated=[]) ~long ?short ?parse_mode ?(meta="path") = mk_path_helper ~setter:(fun var x -> var := x) ~decode_json:(string_json_decoder ~long) ~default_to_string:(fun s -> s) - ~default ~deprecated ~long ~short ~exes ~meta + ~default ~deprecated ~long ~short ~parse_mode ~meta -let mk_path_opt ?default ?(deprecated=[]) ~long ?short ?exes ?(meta="path") = +let mk_path_opt ?default ?(deprecated=[]) ~long ?short ?parse_mode ?(meta="path") = mk_path_helper ~setter:(fun var x -> var := Some x) ~decode_json:(string_json_decoder ~long) ~default_to_string:(function Some s -> s | None -> "") - ~default ~deprecated ~long ~short ~exes ~meta + ~default ~deprecated ~long ~short ~parse_mode ~meta -let mk_path_list ?(default=[]) ?(deprecated=[]) ~long ?short ?exes ?(meta="path") = +let mk_path_list ?(default=[]) ?(deprecated=[]) ~long ?short ?parse_mode ?(meta="path") = mk_path_helper ~setter:(fun var x -> var := x :: !var) ~decode_json:(list_json_decoder (string_json_decoder ~long)) ~default_to_string:(String.concat ~sep:", ") - ~default ~deprecated ~long ~short ~exes ~meta + ~default ~deprecated ~long ~short ~parse_mode ~meta -let mk_symbol ~default ~symbols ~eq ?(deprecated=[]) ~long ?short ?exes ?(meta="") doc = +let mk_symbol ~default ~symbols ~eq ?(deprecated=[]) ~long ?short ?parse_mode ?(meta="") doc = let strings = IList.map fst symbols in let sym_to_str = IList.map (fun (x,y) -> (y,x)) symbols in let of_string str = IList.assoc String.equal str symbols in let to_string sym = IList.assoc eq sym sym_to_str in - mk ~deprecated ~long ?short ~default ?exes ~meta doc + mk ~deprecated ~long ?short ~default ?parse_mode ~meta doc ~default_to_string:(fun s -> to_string s) ~mk_setter:(fun var str -> var := of_string str) ~decode_json:(string_json_decoder ~long) ~mk_spec:(fun set -> Symbol (strings, set)) -let mk_symbol_opt ~symbols ?(deprecated=[]) ~long ?short ?exes ?(meta="") doc = +let mk_symbol_opt ~symbols ?(deprecated=[]) ~long ?short ?parse_mode ?(meta="") doc = let strings = IList.map fst symbols in let of_string str = IList.assoc String.equal str symbols in - mk ~deprecated ~long ?short ~default:None ?exes ~meta doc + mk ~deprecated ~long ?short ~default:None ?parse_mode ~meta doc ~default_to_string:(fun _ -> "") ~mk_setter:(fun var str -> var := Some (of_string str)) ~decode_json:(string_json_decoder ~long) ~mk_spec:(fun set -> Symbol (strings, set)) -let mk_symbol_seq ?(default=[]) ~symbols ~eq ?(deprecated=[]) ~long ?short ?exes ?(meta="") doc = +let mk_symbol_seq ?(default=[]) ~symbols ~eq ?(deprecated=[]) ~long ?short ?parse_mode + ?(meta="") doc = let sym_to_str = IList.map (fun (x,y) -> (y,x)) symbols in let of_string str = IList.assoc String.equal str symbols in let to_string sym = IList.assoc eq sym sym_to_str in - mk ~deprecated ~long ?short ~default ?exes ~meta:(",-separated sequence" ^ meta) doc + mk ~deprecated ~long ?short ~default ?parse_mode ~meta:(",-separated sequence" ^ meta) doc ~default_to_string:(fun syms -> String.concat ~sep:" " (IList.map to_string syms)) ~mk_setter:(fun var str_seq -> var := IList.map of_string (Str.split (Str.regexp_string ",") str_seq)) @@ -482,133 +537,41 @@ let mk_symbol_seq ?(default=[]) ~symbols ~eq ?(deprecated=[]) ~long ?short ?exes ~mk_spec:(fun set -> String set) let mk_set_from_json ~default ~default_to_string ~f - ?(deprecated=[]) ~long ?short ?exes ?(meta="json") doc = - mk ~deprecated ~long ?short ?exes ~meta doc + ?(deprecated=[]) ~long ?short ?parse_mode ?(meta="json") doc = + mk ~deprecated ~long ?short ?parse_mode ~meta doc ~default ~default_to_string ~mk_setter:(fun var json -> var := f (Yojson.Basic.from_string json)) ~decode_json:(fun json -> [dashdash long; Yojson.Basic.to_string json]) ~mk_spec:(fun set -> String set) -let mk_json ?(deprecated=[]) ~long ?short ?exes ?(meta="json") doc = - mk ~deprecated ~long ?short ?exes ~meta doc +let mk_json ?(deprecated=[]) ~long ?short ?parse_mode ?(meta="json") doc = + mk ~deprecated ~long ?short ?parse_mode ~meta doc ~default:(`List []) ~default_to_string:Yojson.Basic.to_string ~mk_setter:(fun var json -> var := Yojson.Basic.from_string json) ~decode_json:(fun json -> [dashdash long; Yojson.Basic.to_string json]) ~mk_spec:(fun set -> String set) -(** A ref to a function used during argument parsing to process anonymous arguments. By default, - anonymous arguments are rejected. *) -let anon_fun = ref (fun arg -> raise (Arg.Bad ("unexpected anonymous argument: " ^ arg))) +(** [mk_anon] always return the same ref. Anonymous arguments are only accepted if + [parse_action_accept_unknown_args] is true. *) +let mk_anon () = rev_anon_args -(** Clients declare that anonymous arguments are acceptable by calling [mk_anon], which returns a - ref storing the anonymous arguments. *) -let mk_anon () = - let anon = ref [] in - anon_fun := (fun arg -> anon := arg :: !anon) ; - anon - -let mk_rest ?(exes=[]) doc = +let mk_rest ?(parse_mode=Infer []) doc = let rest = ref [] in let spec = Rest (fun arg -> rest := arg :: !rest) in - 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 = - 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 _ -> []} ; + add parse_mode {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 -> - json - | Error msg -> - warnf "WARNING: Could not read or parse Infer config in %s:@\n%s@." path msg ; - `Assoc [] in - let desc_list = !(IList.assoc equal_exe current_exe exe_desc_lists) in - let json_config = YBU.to_assoc json in - let one_config_item result (key, json_val) = - try - let {decode_json} = - IList.find - (fun {long; short} -> - String.equal key long - || (* for deprecated options *) String.equal key short) - desc_list in - decode_json json_val @ result - with - | Not_found -> - warnf "WARNING: while reading config file %s:@\nUnknown option %s@." path key ; - result - | YBU.Type_error (msg, json) -> - warnf "WARNING: while reading config file %s:@\nIll-formed value %s for option %s: %s@." - path (Yojson.Basic.to_string json) key msg ; - result in - IList.fold_left one_config_item [] json_config - - -(** separator of argv elements when encoded into environment variables *) -let env_var_sep = '^' - -let encode_argv_to_env argv = - String.concat ~sep:(String.make 1 env_var_sep) - (IList.filter (fun arg -> - not (String.contains arg env_var_sep) - || ( - warnf "Ignoring unsupported option containing '%c' character: %s@\n" - env_var_sep arg ; - false - ) - ) argv) - -let decode_env_to_argv env = - Str.split (Str.regexp_string (String.make 1 env_var_sep)) env - -let prepend_to_argv args = - let cl_args = match Array.to_list Sys.argv with _ :: tl -> tl | [] -> [] in - args @ cl_args - -(** [prefix_before_rest (prefix @ ["--" :: rest])] is [prefix] where "--" is not in [prefix]. *) -let rev_prefix_before_rest args = - let rec rev_prefix_before_rest_ rev_keep = function - | [] | "--" :: _ -> rev_keep - | keep :: args -> rev_prefix_before_rest_ (keep :: rev_keep) args in - rev_prefix_before_rest_ [] args - - -(** environment variable use to pass arguments from parent to child processes *) -let args_env_var = "INFER_ARGS" - -let extra_env_args = ref [] - -let extend_env_args args = - extra_env_args := List.rev_append args !extra_env_args - -let parse ?(incomplete=false) ?config_file current_exe exe_usage ~should_parse_cl_args = - let full_speclist = ref [] - in - let usage_msg = exe_usage current_exe - in - let convert_spec_triple (x, spec, y) = (x, to_arg_spec spec, y) in - let convert_speclist = List.map ~f:convert_spec_triple in +let set_curr_speclist_for_parse_action ~incomplete ~usage parse_action = + let full_speclist = ref [] in let curr_usage status = prerr_endline (String.concat_array ~sep:" " !args_to_parse) ; - Arg.usage !curr_speclist usage_msg ; + Arg.usage !curr_speclist usage ; exit status and full_usage status = - Arg.usage (convert_speclist !full_speclist) usage_msg ; + Arg.usage (to_arg_speclist !full_speclist) usage ; exit status in + let parse_tag = to_parse_tag parse_action in (* "-help" and "--help" are automatically recognized by Arg.parse, so we have to give them special treatment *) let add_or_suppress_help (speclist, (doc_width,left_width)) = @@ -617,7 +580,14 @@ let parse ?(incomplete=false) ?config_file current_exe exe_usage ~should_parse_c let mk_spec ~long ?(short="") spec doc = pad_and_xform doc_width left_width { long; short; meta=""; spec; doc; decode_json=fun _ -> raise (Arg.Bad long)} in - if incomplete then + if not (equal_parse_tag parse_tag (Infer ())) then + let skip opt = + (opt, Unit (fun () -> ()), "") in + speclist @ [ + (skip "--help") ; + (skip "-help") + ] + else if incomplete then speclist @ [ (unknown "--help") ; (unknown "-help") @@ -653,15 +623,21 @@ let parse ?(incomplete=false) ?config_file current_exe exe_usage ~should_parse_c let sort speclist = IList.sort compare_specs speclist in align (sort speclist) in - let add_to_curr_speclist ?(add_help=false) ?header exe = + let add_to_curr_speclist ?(add_help=false) ?header parse_action = let mk_header_spec heading = ("", Unit (fun () -> ()), "\n " ^ heading ^ "\n") in - let exe_descs = IList.assoc equal_exe exe exe_desc_lists in + let exe_descs = + match parse_action with + | Infer section -> + List.Assoc.find_exn ~equal:equal_section infer_section_desc_lists section + | Javac | NoParse -> + to_parse_tag parse_action + |> List.Assoc.find_exn ~equal:equal_parse_tag parse_tag_desc_lists in let (exe_speclist, widths) = normalize !exe_descs in let exe_speclist = if add_help then add_or_suppress_help (exe_speclist, widths) else exe_speclist in - let exe_speclist = convert_speclist exe_speclist in + let exe_speclist = to_arg_speclist exe_speclist in (* Return false if the same option appears in [speclist], unless [doc] is non-empty and the documentation in [speclist] is empty. The goal is to keep only one instance of each option, and that instance is the one that has a non-empty docstring if there is one. *) @@ -672,7 +648,7 @@ let parse ?(incomplete=false) ?config_file current_exe exe_usage ~should_parse_c let unique_exe_speclist = IList.filter (is_not_dup_with_doc !curr_speclist) exe_speclist in curr_speclist := IList.filter (is_not_dup_with_doc unique_exe_speclist) !curr_speclist @ (match header with - | Some s -> (convert_spec_triple (mk_header_spec s)):: unique_exe_speclist + | Some s -> (to_arg_spec_triple (mk_header_spec s)):: unique_exe_speclist | None -> unique_exe_speclist) in (* speclist includes args for current exe with docs, and all other args without docs, so @@ -680,47 +656,131 @@ let parse ?(incomplete=false) ?config_file current_exe exe_usage ~should_parse_c current exe *) (* reset the speclist between calls to this function *) curr_speclist := []; - if equal_exe current_exe Driver then ( - add_to_curr_speclist ~add_help:true ~header:"Driver options" current_exe; - add_to_curr_speclist ~header:"Analysis (backend) options" Analyze; - add_to_curr_speclist ~header:"Clang frontend options" Clang + if equal_parse_action parse_action (Infer Driver) then ( + add_to_curr_speclist ~add_help:true ~header:"Driver options" (Infer Driver); + add_to_curr_speclist ~header:"Analysis (backend) options" (Infer Analysis); + add_to_curr_speclist ~header:"Clang frontend options" (Infer Clang) ) else - add_to_curr_speclist ~add_help:true current_exe + add_to_curr_speclist ~add_help:true parse_action ; assert( check_no_duplicates !curr_speclist ) ; + let full_desc_list = List.Assoc.find_exn ~equal:equal_parse_tag parse_tag_desc_lists parse_tag in full_speclist := add_or_suppress_help (normalize !full_desc_list) ; - let env_args = decode_env_to_argv (Option.value (Sys.getenv args_env_var) ~default:"") in + curr_usage + + +let select_parse_action ~incomplete ~usage action = + let usage = set_curr_speclist_for_parse_action ~incomplete ~usage action in + unknown_args_action := if accept_unknown_args action then `Add else `Reject; + usage + +let mk_rest_actions ?(parse_mode=Infer []) doc ~usage decode_action = + let rest = ref [] in + let spec = String (fun arg -> + rest := List.rev (Array.to_list (Array.slice !args_to_parse (!arg_being_parsed + 1) 0)) ; + select_parse_action ~incomplete:false ~usage (decode_action arg) |> ignore; + (* stop accepting new anonymous arguments *) + unknown_args_action := `Skip) in + add parse_mode {long = "--"; short = ""; meta = ""; doc; spec; decode_json = fun _ -> []} ; + rest + + +let decode_inferconfig_to_argv path = + let json = match Utils.read_optional_json_file path with + | Ok json -> + json + | Error msg -> + warnf "WARNING: Could not read or parse Infer config in %s:@\n%s@." path msg ; + `Assoc [] in + let desc_list = List.Assoc.find_exn ~equal:equal_parse_tag parse_tag_desc_lists (Infer ()) in + let json_config = YBU.to_assoc json in + let one_config_item result (key, json_val) = + try + let {decode_json} = + IList.find + (fun {long; short} -> + String.equal key long + || (* for deprecated options *) String.equal key short) + !desc_list in + decode_json json_val @ result + with + | Not_found -> + warnf "WARNING: while reading config file %s:@\nUnknown option %s@." path key ; + result + | YBU.Type_error (msg, json) -> + warnf "WARNING: while reading config file %s:@\nIll-formed value %s for option %s: %s@." + path (Yojson.Basic.to_string json) key msg ; + result in + IList.fold_left one_config_item [] json_config + + +(** separator of argv elements when encoded into environment variables *) +let env_var_sep = '^' + +let encode_argv_to_env argv = + String.concat ~sep:(String.make 1 env_var_sep) + (IList.filter (fun arg -> + not (String.contains arg env_var_sep) + || ( + warnf "Ignoring unsupported option containing '%c' character: %s@\n" + env_var_sep arg ; + false + ) + ) argv) + +let decode_env_to_argv env = + Str.split (Str.regexp_string (String.make 1 env_var_sep)) env + +(** [prefix_before_rest (prefix @ ["--" :: rest])] is [prefix] where "--" is not in [prefix]. *) +let rev_prefix_before_rest args = + let rec rev_prefix_before_rest_ rev_keep = function + | [] | "--" :: _ -> rev_keep + | keep :: args -> rev_prefix_before_rest_ (keep :: rev_keep) args in + rev_prefix_before_rest_ [] args + + +(** environment variable use to pass arguments from parent to child processes *) +let args_env_var = "INFER_ARGS" + +let extra_env_args = ref [] + +let extend_env_args args = + extra_env_args := List.rev_append args !extra_env_args + +let parse_args ~incomplete ~usage action args = let exe_name = Sys.executable_name in - let env_cl_args = - if should_parse_cl_args then prepend_to_argv env_args - else env_args in - let all_args = match config_file with - | None -> env_cl_args - | Some path -> - let json_args = decode_inferconfig_to_argv current_exe path in - (* read .inferconfig first, as both env vars and command-line options overwrite it *) - json_args @ env_cl_args in - args_to_parse := Array.of_list (exe_name :: all_args); + args_to_parse := Array.of_list (exe_name :: args); arg_being_parsed := 0; + let curr_usage = select_parse_action ~incomplete ~usage action in (* tests if msg indicates an unknown option, as opposed to a known option with bad argument *) let is_unknown msg = String.is_substring msg ~substring:": unknown option" in - accept_unknown_args := false ; let rec parse_loop () = try Arg.parse_argv_dynamic ~current:arg_being_parsed !args_to_parse curr_speclist - (fun arg -> !anon_fun arg) usage_msg + anon_fun usage with | Arg.Bad _ when incomplete -> parse_loop () - | 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 + | Arg.Bad usage_msg -> + if !unknown_args_action <> `Reject && is_unknown usage_msg then ( + anon_fun !args_to_parse.(!arg_being_parsed); + parse_loop () + ) else ( + Pervasives.prerr_string usage_msg; + exit 2 + ) | Arg.Help usage_msg -> Pervasives.print_string usage_msg; exit 0 in parse_loop (); - if not incomplete then ( + curr_usage + +let parse ?(incomplete=false) ?config_file ~usage action = + let env_args = decode_env_to_argv (Option.value (Sys.getenv args_env_var) ~default:"") in + let inferconfig_args = + Option.map ~f:decode_inferconfig_to_argv config_file |> Option.value ~default:[] in + let args_to_export = ref "" in + let add_parsed_args_to_args_to_export () = (* reread args_to_parse instead of using all_args since mk_path_helper may have modified them *) let prog_args = List.rev_append @@ -728,6 +788,20 @@ let parse ?(incomplete=false) ?config_file current_exe exe_usage ~should_parse_c (List.rev !extra_env_args) in (* do not include program path in args passed via env var *) let args = Option.value (List.tl prog_args) ~default:[] in - Unix.putenv ~key:args_env_var ~data:(encode_argv_to_env args) - ); + if not (List.is_empty args) then + let arg_string = + if String.equal !args_to_export "" then encode_argv_to_env args + else !args_to_export ^ String.of_char env_var_sep ^ encode_argv_to_env args in + args_to_export := arg_string in + (* read .inferconfig first, then env vars, then command-line options *) + parse_args ~incomplete ~usage (Infer Driver) inferconfig_args |> ignore; + if not incomplete then add_parsed_args_to_args_to_export (); + parse_args ~incomplete ~usage (Infer Driver) env_args |> ignore; + if not incomplete then add_parsed_args_to_args_to_export (); + let curr_usage = + let cl_args = match Array.to_list Sys.argv with _ :: tl -> tl | [] -> [] in + let curr_usage = parse_args ~incomplete ~usage action cl_args in + if not incomplete then add_parsed_args_to_args_to_export (); + curr_usage in + if not incomplete then Unix.putenv ~key:args_env_var ~data:!args_to_export; curr_usage diff --git a/infer/src/base/CommandLineOption.mli b/infer/src/base/CommandLineOption.mli index 8e6805868..20e6be051 100644 --- a/infer/src/base/CommandLineOption.mli +++ b/infer/src/base/CommandLineOption.mli @@ -22,6 +22,17 @@ val exe_name : exe -> string val frontend_exes: exe list +(** a section is a part of infer that can be affected by an infer option *) +type section = Analysis | Clang | Driver | Java | Print [@@deriving compare] + +val all_sections : section list + +type 'a parse = Infer of 'a | Javac | NoParse + +type parse_mode = section list parse [@@deriving compare] + +type parse_action = section parse [@@deriving compare] + val is_originator : bool val init_work_dir : string @@ -38,14 +49,15 @@ val init_work_dir : string - [f] specifies a transformation to be performed on the parsed value before setting the config variable - [symbols] is an association list sometimes used in place of [f] - - [exes] declares that the option should be included in the external documentation (--help) for - each [exe] in [exes], otherwise it appears only in --help-full + - [parse_mode] declares which parse mode the option is for. In the case of Infer, that includes + the sections for which the option should be included in the external documentation (--help), + otherwise it appears only in --help-full - [meta] is a meta-variable naming the parsed value for documentation purposes - a documentation string *) type 'a t = ?deprecated:string list -> long:string -> ?short:string -> - ?exes:exe list -> ?meta:string -> string -> + ?parse_mode:parse_mode -> ?meta:string -> string -> 'a (** [mk_set variable value] defines a command line option which sets [variable] to [value]. *) @@ -116,27 +128,26 @@ val mk_json : Yojson.Basic.json ref t (** [mk_anon ()] defines a [string list ref] of the anonymous command line arguments, in the reverse order they appeared on the command line. *) -val mk_anon : - unit -> - string list ref +val mk_anon : unit -> string list ref (** [mk_rest doc] 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_rest] and parsing [exe -opt1 -opt2 -- arg1 arg2] will result in the returned ref containing [arg2; arg1]. *) val mk_rest : - ?exes:exe list -> string -> + ?parse_mode:parse_mode -> 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 +(** [mk_rest_actions doc ~usage command_to_parse_action] defines a [string list ref] of the command + line arguments following ["--"], in the reverse order they appeared on the command line. [usage] + is the usage message in case of parse errors or if --help is passed. For example, calling + [mk_action] 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_parse_action] to obtain the parse action that will be used to parse the remaining + arguments. *) +val mk_rest_actions : + ?parse_mode:parse_mode -> string -> + usage:string -> (string -> parse_action) + -> string list ref (** environment variable use to pass arguments from parent to child processes *) val args_env_var : string @@ -147,24 +158,23 @@ val env_var_sep : char (** [extend_env_args args] appends [args] to those passed via [args_env_var] *) val extend_env_args : string list -> unit -(** [parse exe exe_usage exe] parses command line arguments as specified by preceding calls to the +(** [parse ~usage parse_action] parses command line arguments as specified by preceding calls to the [mk_*] functions, and returns a function that prints the usage message and help text then exits. - [exe] is used to construct the help message appropriate for that executable. - The decoded values of the inferconfig file [config_file], if provided, are parsed, followed by the decoded values of the environment variable [args_env_var], followed by [Sys.argv] if - [should_parse_cl_args] is true. Therefore arguments passed on the command line supersede those + [parse_action] is one that should parse command line arguments (this is defined in the + implementation of this module). Therefore arguments passed on the command line supersede those specified in the environment variable, which themselves supersede those passed via the config file. If [incomplete] is set, unknown options are ignored, and [args_env_var] is not set. WARNING: An argument will be interpreted as many times as it appears in all of the config file, - the environment variable, and the command line. The [args_env_var] is set to the full set of - options parsed. *) + the environment variable, and the command line. The [args_env_var] is set to the set of options + parsed in [args_env_var] and on the command line. *) val parse : ?incomplete:bool -> ?config_file:string -> - exe -> (exe -> Arg.usage_msg) -> should_parse_cl_args:bool -> (int -> 'a) + usage:Arg.usage_msg -> parse_action -> (int -> 'a) (** [is_env_var_set var] is true if $[var]=1 *) val is_env_var_set : string -> bool diff --git a/infer/src/base/Config.ml b/infer/src/base/Config.ml index 8086624ed..2d2867d7e 100644 --- a/infer/src/base/Config.ml +++ b/infer/src/base/Config.ml @@ -247,7 +247,7 @@ let real_exe_name = let current_exe = if !Sys.interactive then CLOpt.Interactive else try IList.assoc String.equal (Filename.basename real_exe_name) CLOpt.exes - with Not_found -> CLOpt.Driver + with Not_found -> ((CLOpt.Driver) : CLOpt.exe) let bin_dir = Filename.dirname real_exe_name @@ -309,31 +309,56 @@ let maven = CLOpt.is_env_var_set infer_inside_maven_env_var let env_inside_maven = `Extend [infer_inside_maven_env_var, "1"] +let infer_is_javac = maven -(** Command Line options *) +let startup_action = + let open CLOpt in + if infer_is_javac then Javac + else match current_exe with + | Analyze -> Infer Analysis + | Clang -> NoParse + | Driver -> Infer Driver + | Interactive -> NoParse + | Print -> Infer Print -let should_parse_cl_args = - (match current_exe with - | Clang | Interactive -> false - | Analyze | Driver | Print -> true) && - not maven + +let exe_usage = match (current_exe : CLOpt.exe) with + | Analyze -> + version_string ^ "\n" ^ + "Usage: InferAnalyze [options]\n\ + Analyze the files captured in the project results directory, which can be specified with \ + the --results-dir option." + | Clang -> + "Usage: internal script to capture compilation commands from clang and clang++. \n\ + You shouldn't need to call this directly." + | Interactive -> + "Usage: interactive ocaml toplevel. To pass infer config options use env variable" + | Print -> + "Usage: InferPrint [options] name1.specs ... namen.specs\n\ + Read, convert, and print .specs files. \ + To process all the .specs in the current directory, pass . as only parameter \ + To process all the .specs in the results directory, use option --results-dir \ + Each spec is printed to standard output unless option -q is used." + | Driver -> + version_string + +(** Command Line options *) (* Declare the phase 1 options *) let inferconfig_home = - let all_exes = IList.map snd CLOpt.exes in CLOpt.mk_path_opt ~long:"inferconfig-home" - ~exes:all_exes ~meta:"dir" "Path to the .inferconfig file" + ~parse_mode:CLOpt.(Infer all_sections) ~meta:"dir" "Path to the .inferconfig file" and project_root = CLOpt.mk_path ~deprecated:["project_root"; "-project_root"] ~long:"project-root" ~short:"pr" ~default:CLOpt.init_work_dir - ~exes:CLOpt.[Analyze;Clang;Driver;Print] + ~parse_mode:CLOpt.(Infer [Analysis;Clang;Driver;Print]) ~meta:"dir" "Specify the root directory of the project" (* Parse the phase 1 options, ignoring the rest *) -let _ : int -> 'a = CLOpt.parse ~incomplete:true current_exe (fun _ -> "") ~should_parse_cl_args +let _ : int -> 'a = CLOpt.parse ~incomplete:true startup_action ~usage:"" (* Define the values that depend on phase 1 options *) @@ -373,8 +398,7 @@ let inferconfig_path = can be defined together sharing a reference. See debug and specs_library below for two different examples. *) -let anon_args = - CLOpt.mk_anon () +let anon_args = CLOpt.mk_anon () and abs_struct = CLOpt.mk_int ~deprecated:["absstruct"] ~long:"abs-struct" ~default:1 @@ -413,7 +437,7 @@ and ( ignore ( let long = "-" ^ suffix in CLOpt.mk_string_list ~long ~meta ~f:(fun _ -> raise (Arg.Bad "invalid option")) - ~exes:CLOpt.[Driver;Print] + ~parse_mode:CLOpt.(Infer [Driver;Print]) help ); IList.map (fun (name, analyzer) -> (analyzer, mk_option name)) string_to_analyzer in @@ -453,7 +477,7 @@ and analyzer = | Capture | Compile | Infer | Eradicate | Checkers | Tracing | Crashcontext | Linters | Quandary | Threadsafety | Bufferoverrun -> () in CLOpt.mk_symbol_opt ~deprecated:["analyzer"] ~long:"analyzer" ~short:"a" - ~exes:CLOpt.[Driver] + ~parse_mode:CLOpt.(Infer [Driver]) "Specify which analyzer to run (only one at a time is supported):\n\ - infer, eradicate, checkers, quandary, threadsafety, bufferoverrun: run the specified analysis\n\ - capture: run capture phase only (no analysis)\n\ @@ -483,18 +507,18 @@ and ast_file = and blacklist = CLOpt.mk_string_opt ~deprecated:["-blacklist-regex";"-blacklist"] ~long:"buck-blacklist" - ~exes:CLOpt.[Driver] + ~parse_mode:CLOpt.(Infer [Driver]) ~meta:"regex" "Skip analysis of files matched by the specified regular expression (Buck \ flavors only)" and bootclasspath = CLOpt.mk_string_opt ~long:"bootclasspath" - ~exes:CLOpt.[Driver] + ~parse_mode:CLOpt.(Infer [Driver]) "Specify the Java bootclasspath" and bo_debug = CLOpt.mk_int ~default:0 ~long:"bo-debug" - ~exes:CLOpt.[Driver] "Debug mode for buffer-overrun checker" + ~parse_mode:CLOpt.(Infer [Driver]) "Debug mode for buffer-overrun checker" (** Automatically set when running from within Buck *) and buck = @@ -503,55 +527,55 @@ and buck = and buck_build_args = CLOpt.mk_string_list ~long:"Xbuck" - ~exes:CLOpt.[Driver] + ~parse_mode:CLOpt.(Infer [Driver]) "Pass values as command-line arguments to invocations of `buck build` (Buck flavors only)" and buck_out = CLOpt.mk_path_opt ~long:"buck-out" - ~exes:CLOpt.[Driver] ~meta:"dir" "Specify the root directory of buck-out" + ~parse_mode:CLOpt.(Infer [Driver]) ~meta:"dir" "Specify the root directory of buck-out" and bugs_csv = CLOpt.mk_path_opt ~deprecated:["bugs"] ~long:"issues-csv" - ~exes:CLOpt.[Driver;Print] + ~parse_mode:CLOpt.(Infer [Driver;Print]) ~meta:"file" "Write a list of issues in CSV format to a file" and bugs_json = CLOpt.mk_path_opt ~deprecated:["bugs_json"] ~long:"issues-json" - ~exes:CLOpt.[Driver;Print] + ~parse_mode:CLOpt.(Infer [Driver;Print]) ~meta:"file" "Write a list of issues in JSON format to a file" and bugs_tests = CLOpt.mk_path_opt ~long:"issues-tests" - ~exes:CLOpt.[Driver;Print] + ~parse_mode:CLOpt.(Infer [Driver;Print]) ~meta:"file" "Write a list of issues in a format suitable for tests to a file" and bugs_txt = CLOpt.mk_path_opt ~deprecated:["bugs_txt"] ~long:"issues-txt" - ~exes:CLOpt.[Driver;Print] + ~parse_mode:CLOpt.(Infer [Driver;Print]) ~meta:"file" "Write a list of issues in TXT format to a file" and bugs_xml = CLOpt.mk_path_opt ~deprecated:["bugs_xml"] ~long:"issues-xml" - ~exes:CLOpt.[Driver;Print] + ~parse_mode:CLOpt.(Infer [Driver;Print]) ~meta:"file" "Write a list of issues in XML format to a file" and calls_csv = CLOpt.mk_path_opt ~deprecated:["calls"] ~long:"calls-csv" - ~exes:CLOpt.[Driver;Print] + ~parse_mode:CLOpt.(Infer [Driver;Print]) ~meta:"file" "Write individual calls in CSV format to a file" and changed_files_index = - CLOpt.mk_path_opt ~long:"changed-files-index" ~exes:CLOpt.[Driver] ~meta:"file" + CLOpt.mk_path_opt ~long:"changed-files-index" ~parse_mode:CLOpt.(Infer [Driver]) ~meta:"file" "Specify the file containing the list of source files from which reactive analysis should \ start. Source files should be specified relative to project root or be absolute" and check_duplicate_symbols = CLOpt.mk_bool ~long:"check-duplicate-symbols" - ~exes:CLOpt.[Analyze] + ~parse_mode:CLOpt.(Infer [Analysis]) "Check if a symbol with the same name is defined in more than one file." and checkers, crashcontext, eradicate, quandary, threadsafety, bufferoverrun = @@ -591,7 +615,7 @@ and checkers_repeated_calls = "Check for repeated calls" and clang_biniou_file = - CLOpt.mk_path_opt ~long:"clang-biniou-file" ~exes:CLOpt.[Clang] ~meta:"file" + CLOpt.mk_path_opt ~long:"clang-biniou-file" ~parse_mode:CLOpt.(Infer [Clang]) ~meta:"file" "Specify a file containing the AST of the program, in biniou format" and clang_compilation_db_files = @@ -600,7 +624,7 @@ and clang_compilation_db_files = and clang_frontend_action = CLOpt.mk_symbol_opt ~long:"clang-frontend-action" - ~exes:CLOpt.[Clang;Driver] + ~parse_mode:CLOpt.(Infer [Clang;Driver]) "Specify whether the clang frontend should capture or lint or both." ~symbols:clang_frontend_action_symbols @@ -621,7 +645,7 @@ and cluster = and compute_analytics = CLOpt.mk_bool ~long:"compute-analytics" ~default:false - ~exes:CLOpt.[Clang;Driver] + ~parse_mode:CLOpt.(Infer [Clang;Driver]) "Emit analytics as info-level issues, like component kit line count and \ component kit file cyclomatic complexity" @@ -629,13 +653,13 @@ and compute_analytics = If a procedure was changed beforehand, keep the changed marking. *) and continue = CLOpt.mk_bool ~deprecated:["continue"] ~long:"continue" - ~exes:CLOpt.[Driver] + ~parse_mode:CLOpt.(Infer [Driver]) "Continue the capture for the reactive analysis, increasing the changed files/procedures. (If \ a procedure was changed beforehand, keep the changed marking.)" and linters_ignore_clang_failures = CLOpt.mk_bool ~long:"linters-ignore-clang-failures" - ~exes:CLOpt.[Driver] + ~parse_mode:CLOpt.(Infer [Driver]) ~default:false "Continue linting files even if some compilation fails." @@ -646,7 +670,7 @@ and copy_propagation = and cxx = CLOpt.mk_bool ~deprecated:["cxx-experimental"] ~long:"cxx" ~default:true - ~exes:CLOpt.[Clang] + ~parse_mode:CLOpt.(Infer [Clang]) "Analyze C++ methods" and ( @@ -669,7 +693,7 @@ and ( and filtering = CLOpt.mk_bool ~long:"filtering" ~short:"f" ~default:true - ~exes:CLOpt.[Driver] + ~parse_mode:CLOpt.(Infer [Driver]) "Do not show the results from experimental checks (note: some of them may contain many false \ alarms)" @@ -705,7 +729,7 @@ and ( in let debug = CLOpt.mk_bool_group ~deprecated:["debug"] ~long:"debug" ~short:"g" - ~exes:CLOpt.[Analyze] + ~parse_mode:CLOpt.(Infer [Analysis]) "Debug mode (also sets --developer-mode, --no-filtering, --print-buckets, --print-types, \ --reports-include-ml-loc, --no-test, --trace-error, --write-dotty, --write-html)" [developer_mode; print_buckets; print_types; reports_include_ml_loc; trace_error; write_html; @@ -739,7 +763,7 @@ and dependencies = and disable_checks = CLOpt.mk_string_list ~deprecated:["disable_checks"] ~long:"disable-checks" ~meta:"error name" - ~exes:CLOpt.[Driver;Print] + ~parse_mode:CLOpt.(Infer [Driver;Print]) "Do not show reports coming from this type of errors" and dotty_cfg_libs = @@ -797,7 +821,7 @@ and err_file = and fail_on_bug = CLOpt.mk_bool ~deprecated:["-fail-on-bug"] ~long:"fail-on-issue" ~default:false - ~exes:CLOpt.[Driver] + ~parse_mode:CLOpt.(Infer [Driver]) (Printf.sprintf "Exit with error code %d if Infer found something to report" fail_on_issue_exit_code) @@ -819,13 +843,13 @@ and filter_paths = and flavors = CLOpt.mk_bool ~deprecated:["-use-flavors"] ~long:"flavors" - ~exes:CLOpt.[Driver] + ~parse_mode:CLOpt.(Infer [Driver]) "Buck integration using Buck flavors (clang only), eg `infer --flavors -- buck build \ //foo:bar#infer`" and from_json_report = CLOpt.mk_path_opt ~long:"from-json-report" - ~exes:CLOpt.[Print] + ~parse_mode:CLOpt.(Infer [Print]) ~meta:"report.json" "Load analysis results from a report file (default is to load the results from the specs \ files generated by the analysis)." @@ -841,17 +865,17 @@ and frontend_stats = and frontend_tests = CLOpt.mk_bool ~long:"frontend-tests" - ~exes:CLOpt.frontend_exes + ~parse_mode:CLOpt.(Infer [Clang]) "Save filename.ext.test.dot with the cfg in dotty format for frontend tests" and generated_classes = CLOpt.mk_path_opt ~long:"generated-classes" - ~exes:CLOpt.[Driver] + ~parse_mode:CLOpt.(Infer [Driver]) "Specify where to load the generated class files" and headers = CLOpt.mk_bool ~deprecated:["headers"] ~deprecated_no:["no_headers"] ~long:"headers" ~short:"hd" - ~exes:CLOpt.[Clang] + ~parse_mode:CLOpt.(Infer [Clang]) "Analyze code in header files" and icfg_dotty_outfile = @@ -864,7 +888,7 @@ and infer_cache = ~meta:"dir" "Select a directory to contain the infer cache (Buck and Java only)" and iphoneos_target_sdk_version = - CLOpt.mk_string_opt ~long:"iphoneos-target-sdk-version" ~exes:CLOpt.[Clang;Driver] + CLOpt.mk_string_opt ~long:"iphoneos-target-sdk-version" ~parse_mode:CLOpt.(Infer [Clang;Driver]) "Specify the target SDK version to use for iphoneos" and iterations = @@ -880,7 +904,8 @@ and java_jar_compiler = and jobs = CLOpt.mk_int ~deprecated:["-multicore"] ~long:"jobs" ~short:"j" ~default:ncpu - ~exes:CLOpt.[Driver] ~meta:"int" "Run the specified number of analysis jobs simultaneously" + ~parse_mode:CLOpt.(Infer [Driver]) + ~meta:"int" "Run the specified number of analysis jobs simultaneously" and join_cond = CLOpt.mk_int ~deprecated:["join_cond"] ~long:"join-cond" ~default:1 @@ -894,19 +919,19 @@ and latex = "Write a latex report of the analysis results to a file" and linters_def_file = - CLOpt.mk_path_list ~default: [linters_def_default_file] - ~long:"linters-def-file" ~exes:CLOpt.[Clang] + CLOpt.mk_path_list ~default:[linters_def_default_file] + ~long:"linters-def-file" ~parse_mode:CLOpt.(Infer [Clang]) ~meta:"file" "Specify the file containing linters definition (e.g. 'linters.al')" and load_average = CLOpt.mk_float_opt ~long:"load-average" ~short:"l" - ~exes:CLOpt.[Driver] ~meta:"float" + ~parse_mode:CLOpt.(Infer [Driver]) ~meta:"float" "Do not start new parallel jobs if the load average is greater than that specified (Buck and \ make only)" and load_results = CLOpt.mk_path_opt ~deprecated:["load_results"] ~long:"load-results" - ~exes:CLOpt.[Analyze] + ~parse_mode:CLOpt.(Infer [Analysis]) ~meta:"file.iar" "Load analysis results from Infer Analysis Results file file.iar" (** name of the makefile to create with clusters and dependencies *) @@ -920,13 +945,13 @@ and margin = and merge = CLOpt.mk_bool ~deprecated:["merge"] ~long:"merge" - ~exes:CLOpt.[Driver] + ~parse_mode:CLOpt.(Infer [Driver]) "Merge the captured results directories specified in the dependency file (Buck flavors only)" and ml_buckets = CLOpt.mk_symbol_seq ~deprecated:["ml_buckets"; "-ml_buckets"] ~long:"ml-buckets" ~default:[`MLeak_cf] - ~exes:CLOpt.[Clang] + ~parse_mode:CLOpt.(Infer [Clang]) "Specify the memory leak buckets to be checked in Objective-C/C++:\n\ - 'cf' checks leaks from Core Foundation,\n\ - 'arc' from code compiled in ARC mode,\n\ @@ -984,7 +1009,7 @@ and patterns_skip_translation = and pmd_xml = CLOpt.mk_bool ~long:"pmd-xml" - ~exes:CLOpt.[Driver] + ~parse_mode:CLOpt.(Infer [Driver]) "Output issues in (PMD) XML format" and precondition_stats = @@ -992,7 +1017,7 @@ and precondition_stats = "Print stats about preconditions to standard output" and print_logs = - CLOpt.mk_bool ~long:"print-logs" ~exes:CLOpt.[Driver] + CLOpt.mk_bool ~long:"print-logs" ~parse_mode:CLOpt.(Infer [Driver]) "Also log messages to stdout and stderr" and print_builtins = @@ -1001,7 +1026,7 @@ and print_builtins = and print_traces_in_tests = CLOpt.mk_bool ~long:"print-traces-in-tests" ~default:true - ~exes:CLOpt.[Print] + ~parse_mode:CLOpt.(Infer [Print]) "Include symbolic traces summaries in the output of --issues-tests" and print_using_diff = @@ -1020,7 +1045,7 @@ and procs_xml = and progress_bar = CLOpt.mk_bool ~deprecated_no:["no_progress_bar"] ~long:"progress-bar" ~short:"pb" ~default:true - ~exes:CLOpt.[Driver] + ~parse_mode:CLOpt.(Infer [Driver]) "Show a progress bar" and quandary_sources = @@ -1030,8 +1055,8 @@ and quandary_sinks = CLOpt.mk_json ~long:"quandary-sinks" "Specify custom sinks for Quandary" and quiet = - CLOpt.mk_bool ~long:"quiet" ~short:"q" ~default:(current_exe <> CLOpt.Print) - ~exes:CLOpt.[Print] + CLOpt.mk_bool ~long:"quiet" ~short:"q" ~default:(current_exe <> (CLOpt.Print : CLOpt.exe)) + ~parse_mode:CLOpt.(Infer [Print]) "Do not print specs on standard output" and reactive = @@ -1058,10 +1083,21 @@ and report_hook = passed --issues-csv, --issues-json, --issues-txt, --issues-xml, --project-root, and \ --results-dir." +and rest = + CLOpt.mk_rest_actions + ~parse_mode:CLOpt.(Infer [Driver]) + "Stop argument processing, use remaining arguments as a build command" + ~usage:exe_usage + (fun build_exe -> + match Filename.basename build_exe with + | "java" | "javac" -> CLOpt.Javac + | _ -> CLOpt.NoParse + ) + and results_dir = CLOpt.mk_path ~deprecated:["results_dir"; "-out"] ~long:"results-dir" ~short:"o" ~default:(CLOpt.init_work_dir ^/ "infer-out") - ~exes:CLOpt.[Analyze;Clang;Driver;Print] + ~parse_mode:CLOpt.(Infer [Analysis;Clang;Driver;Print]) ~meta:"dir" "Write results and internal files in the specified directory" and save_results = @@ -1074,17 +1110,17 @@ and seconds_per_iteration = and skip_analysis_in_path = CLOpt.mk_string_list ~long:"skip-analysis-in-path" - ~exes:CLOpt.[Clang] + ~parse_mode:CLOpt.(Infer [Clang]) ~meta:"path prefix" "Ignore files whose path matches the given prefix" and skip_clang_analysis_in_path = CLOpt.mk_string_list ~long:"skip-clang-analysis-in-path" - ~exes:CLOpt.[Clang] + ~parse_mode:CLOpt.(Infer [Clang]) ~meta:"path prefix" "Ignore files whose path matches the given prefix" and skip_translation_headers = CLOpt.mk_string_list ~deprecated:["skip_translation_headers"] ~long:"skip-translation-headers" - ~exes:CLOpt.[Clang] + ~parse_mode:CLOpt.(Infer [Clang]) ~meta:"path prefix" "Ignore headers whose path matches the given prefix" and sources = @@ -1124,18 +1160,18 @@ and specs_library = ~long:"specs-library-index" ~default:"" ~f:(fun file -> specs_library := (read_specs_dir_list_file file) @ !specs_library; "") - ~exes:CLOpt.[Analyze] ~meta:"file" + ~parse_mode:CLOpt.(Infer [Analysis]) ~meta:"file" "" in specs_library and stacktrace = - CLOpt.mk_path_opt ~long:"stacktrace" ~short:"st" ~exes:CLOpt.[Driver] + CLOpt.mk_path_opt ~long:"stacktrace" ~short:"st" ~parse_mode:CLOpt.(Infer [Driver]) ~meta:"file" "File path containing a json-encoded Java crash stacktrace. Used to guide the \ analysis (only with '-a crashcontext'). See \ tests/codetoanalyze/java/crashcontext/*.json for examples of the expected format." and stacktraces_dir = - CLOpt.mk_path_opt ~long:"stacktraces-dir" ~exes:CLOpt.[Driver] + CLOpt.mk_path_opt ~long:"stacktraces-dir" ~parse_mode:CLOpt.(Infer [Driver]) ~meta:"dir" "Directory path containing multiple json-encoded Java crash stacktraces. \ Used to guide the analysis (only with '-a crashcontext'). See \ tests/codetoanalyze/java/crashcontext/*.json for examples of the expected format." @@ -1186,7 +1222,7 @@ and type_size = and unsafe_malloc = CLOpt.mk_bool ~long:"unsafe-malloc" - ~exes:CLOpt.[Analyze] + ~parse_mode:CLOpt.(Infer [Analysis]) "Assume that malloc(3) never returns null." and use_compilation_database = @@ -1202,13 +1238,13 @@ and verbose_out = and version = let var = ref `None in CLOpt.mk_set var `Full ~deprecated:["version"] ~long:"version" - ~exes:CLOpt.[Analyze;Clang;Driver;Print] + ~parse_mode:CLOpt.(Infer [Analysis;Clang;Driver;Print]) "Print version information and exit" ; CLOpt.mk_set var `Json ~deprecated:["version_json"] ~long:"version-json" - ~exes:CLOpt.[Analyze;Clang;Print] + ~parse_mode:CLOpt.(Infer [Analysis;Clang;Print]) "Print version information in json format and exit" ; CLOpt.mk_set var `Vcs ~long:"version-vcs" - ~exes:CLOpt.[Analyze;Clang;Print] + ~parse_mode:CLOpt.(Infer [Analysis;Clang;Print]) "Print version control system commit and exit" ; var @@ -1232,13 +1268,13 @@ and worklist_mode = and xcode_developer_dir = CLOpt.mk_path_opt ~long:"xcode-developer-dir" - ~exes:CLOpt.[Driver] + ~parse_mode:CLOpt.(Infer [Driver]) ~meta:"XCODE_DEVELOPER_DIR" "Specify the path to Xcode developer directory (Buck flavors only)" and xcpretty = CLOpt.mk_bool ~long:"xcpretty" ~default:true - ~exes:CLOpt.[Driver] + ~parse_mode:CLOpt.(Infer [Driver]) "Infer will use xcpretty together with xcodebuild to analyze an iOS app. xcpretty just needs \ to be in the path, infer command is still just infer -- . (Recommended)" @@ -1246,69 +1282,44 @@ and xml_specs = CLOpt.mk_bool ~deprecated:["xml"] ~long:"xml-specs" "Export specs into XML files file1.xml ... filen.xml" -let javac_classes_out = ref CLOpt.init_work_dir - (* 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 = - (* BUG: these arguments will not be detected if put inside @argfiles, as supported by javac. See - Infer.run_javac for a version that looks inside argfiles, and discussion in D4397716. *) - let classes_out_spec = - Arg.String (fun classes_out -> - javac_classes_out := classes_out ; + +(* BUG: these arguments will not be detected if put inside @argfiles, as supported by javac. See + Infer.run_javac for a version that looks inside argfiles, and discussion in D4397716. *) +let javac_classes_out = + CLOpt.mk_string ~parse_mode:CLOpt.Javac + ~deprecated:["classes_out"] ~short:"d" ~long:"" ~default:CLOpt.init_work_dir + ~f:(fun classes_out -> if !buck then ( let classes_out_infer = resolve classes_out ^/ buck_results_dir_name in (* extend env var args to pass args to children that do not receive the rest args *) CLOpt.extend_env_args ["--results-dir"; classes_out_infer] ; - results_dir := classes_out_infer - ) - ) in - let classpath_spec = - Arg.String (fun classpath -> + results_dir := classes_out_infer; + ); + classes_out) + "" + +and java_classpath = + CLOpt.mk_string_opt ~parse_mode:CLOpt.Javac + ~deprecated:["classpath"] ~short:"cp" ~long:"" + ~f:(fun classpath -> if !buck then ( let paths = String.split classpath ~on:':' in let files = List.filter paths ~f:(fun path -> Sys.is_file path = `Yes) in CLOpt.extend_env_args (List.concat_map files ~f:(fun file -> ["--specs-library"; file])) ; specs_library := List.rev_append files !specs_library - ) - ) in - let version_spec = Arg.Unit (fun () -> version := `Javac) in - CLOpt.mk_subcommand - ~exes:CLOpt.[Driver] - "Stop argument processing, use remaining arguments as a build command" - (fun build_exe -> - match Filename.basename build_exe with - | "java" | "javac" -> [ - ("-classes_out", classes_out_spec, ""); ("-d", classes_out_spec, ""); - ("-classpath", classpath_spec, ""); ("-cp", classpath_spec, ""); - ("-version", version_spec, "") - ] - | _ -> [] - ) + ); + classpath) + "" -(** Parse Command Line Args *) +and () = + CLOpt.mk_set ~parse_mode:CLOpt.Javac version + ~deprecated:["version"] ~long:"" `Javac + "" -let exe_usage (exe : CLOpt.exe) = - match exe with - | Analyze -> - version_string ^ "\n" ^ - "Usage: InferAnalyze [options]\n\ - Analyze the files captured in the project results directory, which can be specified with \ - the --results-dir option." - | Clang -> - "Usage: internal script to capture compilation commands from clang and clang++. \n\ - You shouldn't need to call this directly." - | Interactive -> - "Usage: interactive ocaml toplevel. To pass infer config options use env variable" - | Print -> - "Usage: InferPrint [options] name1.specs ... namen.specs\n\ - Read, convert, and print .specs files. \ - To process all the .specs in the current directory, pass . as only parameter \ - To process all the .specs in the results directory, use option --results-dir \ - Each spec is printed to standard output unless option -q is used." - | Driver -> - version_string +(** Parse Command Line Args *) let post_parsing_initialization () = (match !version with @@ -1318,8 +1329,15 @@ let post_parsing_initialization () = | `Javac when !buck -> (* print buck key *) let javac_version = + let javac_args = + if infer_is_javac then + match Array.to_list Sys.argv with + | [] -> [] + | _::args -> "javac"::args + else + List.rev !rest in (* stderr contents of build command *) - let chans = Unix.open_process_full (String.concat ~sep:" " (List.rev !rest)) ~env:[||] in + let chans = Unix.open_process_full (String.concat ~sep:" " javac_args) ~env:[||] in let err = String.strip (In_channel.input_all chans.stderr) in Unix.close_process_full chans |> ignore; err in @@ -1376,7 +1394,7 @@ let post_parsing_initialization () = let parse_args_and_return_usage_exit = let usage_exit = - CLOpt.parse ~config_file:inferconfig_path current_exe exe_usage ~should_parse_cl_args in + CLOpt.parse ~config_file:inferconfig_path ~usage:exe_usage startup_action in post_parsing_initialization () ; usage_exit