add support for subcommands not after --

Summary:
Support several parsing modes: Infer, Javac, NoParse

The "Infer" mode specifies a list of sections, ie the parts of infer that are affected by an option (corresponds to the old notion of "exes"):
analysis, clang frontend, print, ...

- .inferconfig and INFER_ARGS always parsed
- outside .inferconfig and INFER_ARGS, do not parse subcommand arguments before the subcommand has been activated
- command-line is parsed or not based on the subcommand/executable selected
- executable dictates subcommand, so almost nothing depends on the executable outside of Config. Another diff will restrict the API around exes to reflect this.

Reviewed By: jberdine

Differential Revision: D4474886

fbshipit-source-id: 442dfef
master
Jules Villard 8 years ago committed by Facebook Github Bot
parent 6faccb1490
commit 744edc10ec

@ -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

@ -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

@ -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 = "<analyzer>-" ^ 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 -- <xcodebuild command>. (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

Loading…
Cancel
Save