pghs975uc
/
infer_clone
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

add support for subcommands not after --

Browse Source 
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
3 changed files with 444 additions and 342 deletions
Show Stats Download Patch File Download Diff File

468
infer/src/base/CommandLineOption.ml
Unescape View File

@ -31,6 +31,9 @@ let to_arg_spec = function
| Symbol (symbols, f) -> Arg.Symbol (symbols, f) | Symbol (symbols, f) -> Arg.Symbol (symbols, f)
| Rest f -> Arg.Rest 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 = let is_env_var_set v =
Option.value (Option.map (Sys.getenv v) ~f:((=) "1")) ~default:false 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; Unix.putenv ~key:"INFER_CWD" ~data:real_cwd;
(real_cwd, true) (real_cwd, true)
let strict_mode = is_env_var_set "INFER_STRICT_MODE"
let warnf = 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 if not is_originator then fun fmt -> F.ifprintf F.err_formatter fmt
else F.eprintf 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 = { type desc = {
long: string; short: string; meta: string; doc: string; spec: spec; 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 *) (** 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) 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 *) (** add [desc] to the one relevant parse_tag_desc_lists for the purposes of parsing, and, in the
let add exes desc = 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 ; full_desc_list := desc :: !full_desc_list ;
IList.iter (fun (exe, desc_list) -> match parse_mode with
let desc = | Javac | NoParse -> ()
if List.mem ~equal:equal_exe exes exe then | Infer sections ->
desc List.iter infer_section_desc_lists ~f:(fun (section, desc_list) ->
else let desc = if List.mem ~equal:equal_section sections section then
{desc with meta = ""; doc = ""} in desc
desc_list := desc :: !desc_list else
) exe_desc_lists {desc with meta = ""; doc = ""} in
desc_list := desc :: !desc_list)
let deprecate_desc ~long ~short ~deprecated desc =
let warn () = let deprecate_desc parse_mode ~long ~short ~deprecated desc =
warnf "WARNING: '-%s' is deprecated. Use '--%s'%s instead.@." let warn () = match parse_mode with
deprecated long (if short = "" then "" else Printf.sprintf " or '-%s'" short) in | 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 warn_then_f f x = warn (); f x in
let deprecated_spec = match desc.spec with let deprecated_spec = match desc.spec with
| Unit f -> Unit (warn_then_f f) | Unit f -> Unit (warn_then_f f)
@ -249,7 +284,7 @@ let deprecate_desc ~long ~short ~deprecated desc =
{ long = ""; short = deprecated; meta = ""; doc = ""; { long = ""; short = deprecated; meta = ""; doc = "";
spec = deprecated_spec; decode_json = deprecated_decode_json } 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 = ~long ?(short="") ~default ~meta doc ~default_to_string ~decode_json ~mk_setter ~mk_spec =
let variable = ref default in let variable = ref default in
let closure = mk_setter variable in let closure = mk_setter variable in
@ -265,16 +300,21 @@ let mk ?(deprecated=[]) ?(exes=[])
else doc ^ " (default: " ^ default_string ^ ")" in else doc ^ " (default: " ^ default_string ^ ")" in
let desc = {long; short; meta; doc; spec; decode_json} 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 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 *) (* 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 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 *) (* add desc for deprecated options only for parsing, without documentation *)
List.iter deprecated ~f:(fun deprecated -> List.iter deprecated ~f:(fun deprecated ->
deprecate_desc ~long ~short ~deprecated desc deprecate_desc parse_mode ~long ~short ~deprecated desc
|> add []) ; |> add parse_mode_no_sections) ;
variable variable
(* begin parsing state *)
(* arguments passed to Arg.parse_argv_dynamic, susceptible to be modified on the fly when parsing *) (* 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 []) 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 *) (* 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 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 = type 'a t =
?deprecated:string list -> long:Arg.key -> ?short:Arg.key -> ?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 'a
let string_json_decoder ~long json = [dashdash long; YBU.to_string json] 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 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 let setter () = var := value in
ignore( ignore(
mk ~deprecated ~long ?short ~default:() ?exes ~meta doc mk ~deprecated ~long ?short ~default:() ?parse_mode ~meta doc
~default_to_string:(fun () -> "") ~default_to_string:(fun () -> "")
~decode_json:(string_json_decoder ~long) ~decode_json:(string_json_decoder ~long)
~mk_setter:(fun _ _ -> setter ()) ~mk_setter:(fun _ _ -> setter ())
~mk_spec:(fun _ -> Unit setter) ) ~mk_spec:(fun _ -> Unit setter) )
let mk_option ?(default=None) ?(default_to_string=fun _ -> "") ~f let mk_option ?(default=None) ?(default_to_string=fun _ -> "") ~f
?(deprecated=[]) ~long ?short ?exes ?(meta="") doc = ?(deprecated=[]) ~long ?short ?parse_mode ?(meta="") doc =
mk ~deprecated ~long ?short ~default ?exes ~meta doc mk ~deprecated ~long ?short ~default ?parse_mode ~meta doc
~default_to_string ~default_to_string
~decode_json:(string_json_decoder ~long) ~decode_json:(string_json_decoder ~long)
~mk_setter:(fun var str -> var := f str) ~mk_setter:(fun var str -> var := f str)
~mk_spec:(fun set -> String set) ~mk_spec:(fun set -> String set)
let mk_bool ?(deprecated_no=[]) ?(default=false) ?(f=fun b -> b) 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 nolong =
let len = String.length long in let len = String.length long in
if len > 3 && String.sub long ~pos:0 ~len:3 = "no-" then 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 default_to_string _ = "" in
let mk_spec set = Unit (fun () -> set "") in let mk_spec set = Unit (fun () -> set "") in
let var = 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) ~meta doc ~default_to_string ~mk_setter:(fun var _ -> var := f true)
~decode_json:(fun json -> ~decode_json:(fun json ->
[dashdash (if YBU.to_bool json then long else nolong)]) [dashdash (if YBU.to_bool json then long else nolong)])
~mk_spec in ~mk_spec in
ignore( 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) ~meta nodoc ~default_to_string ~mk_setter:(fun _ _ -> var := f false)
~decode_json:(fun json -> ~decode_json:(fun json ->
[dashdash (if YBU.to_bool json then nolong else long)]) [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 var
let mk_bool_group ?(deprecated_no=[]) ?(default=false) 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 = let f b =
IList.iter (fun child -> child := b) children ; IList.iter (fun child -> child := b) children ;
IList.iter (fun child -> child := not b) no_children ; IList.iter (fun child -> child := not b) no_children ;
b b
in 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 = let mk_int ~default ?(deprecated=[]) ~long ?short ?parse_mode ?(meta="") doc =
mk ~deprecated ~long ?short ~default ?exes ~meta doc mk ~deprecated ~long ?short ~default ?parse_mode ~meta doc
~default_to_string:string_of_int ~default_to_string:string_of_int
~mk_setter:(fun var str -> var := (int_of_string str)) ~mk_setter:(fun var str -> var := (int_of_string str))
~decode_json:(string_json_decoder ~long) ~decode_json:(string_json_decoder ~long)
~mk_spec:(fun set -> String set) ~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 default_to_string = function Some f -> string_of_int f | None -> "" in
let f s = Some (int_of_string s) 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 = let mk_float ~default ?(deprecated=[]) ~long ?short ?parse_mode ?(meta="") doc =
mk ~deprecated ~long ?short ~default ?exes ~meta doc mk ~deprecated ~long ?short ~default ?parse_mode ~meta doc
~default_to_string:string_of_float ~default_to_string:string_of_float
~mk_setter:(fun var str -> var := (float_of_string str)) ~mk_setter:(fun var str -> var := (float_of_string str))
~decode_json:(string_json_decoder ~long) ~decode_json:(string_json_decoder ~long)
~mk_spec:(fun set -> String set) ~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 default_to_string = function Some f -> string_of_float f | None -> "" in
let f s = Some (float_of_string s) 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 = let mk_string ~default ?(f=fun s -> s) ?(deprecated=[]) ~long ?short ?parse_mode ?(meta="") doc =
mk ~deprecated ~long ?short ~default ?exes ~meta doc mk ~deprecated ~long ?short ~default ?parse_mode ~meta doc
~default_to_string:(fun s -> s) ~default_to_string:(fun s -> s)
~mk_setter:(fun var str -> var := f str) ~mk_setter:(fun var str -> var := f str)
~decode_json:(string_json_decoder ~long) ~decode_json:(string_json_decoder ~long)
~mk_spec:(fun set -> String set) ~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 default_to_string = function Some s -> s | None -> "" in
let f s = Some (f s) 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) let mk_string_list ?(default=[]) ?(f=fun s -> s)
?(deprecated=[]) ~long ?short ?exes ?(meta="") doc = ?(deprecated=[]) ~long ?short ?parse_mode ?(meta="") doc =
mk ~deprecated ~long ?short ~default ?exes ~meta doc mk ~deprecated ~long ?short ~default ?parse_mode ~meta doc
~default_to_string:(String.concat ~sep:", ") ~default_to_string:(String.concat ~sep:", ")
~mk_setter:(fun var str -> var := (f str) :: !var) ~mk_setter:(fun var str -> var := (f str) :: !var)
~decode_json:(list_json_decoder (string_json_decoder ~long)) ~decode_json:(list_json_decoder (string_json_decoder ~long))
~mk_spec:(fun set -> String set) ~mk_spec:(fun set -> String set)
let mk_path_helper ~setter ~default_to_string 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 = let normalize_path_in_args_being_parsed str =
if Filename.is_relative str then ( if Filename.is_relative str then (
(* Replace relative paths with absolute ones on the fly in the args being parsed. This assumes (* 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 abs_path
) else ) else
str in str in
mk ~deprecated ~long ?short ~default ?exes ~meta doc mk ~deprecated ~long ?short ~default ?parse_mode ~meta doc
~decode_json ~default_to_string ~decode_json ~default_to_string
~mk_setter:(fun var str -> ~mk_setter:(fun var str ->
let abs_path = normalize_path_in_args_being_parsed str in let abs_path = normalize_path_in_args_being_parsed str in
setter var abs_path) setter var abs_path)
~mk_spec:(fun set -> String set) ~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 mk_path_helper
~setter:(fun var x -> var := x) ~setter:(fun var x -> var := x)
~decode_json:(string_json_decoder ~long) ~decode_json:(string_json_decoder ~long)
~default_to_string:(fun s -> s) ~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 mk_path_helper
~setter:(fun var x -> var := Some x) ~setter:(fun var x -> var := Some x)
~decode_json:(string_json_decoder ~long) ~decode_json:(string_json_decoder ~long)
~default_to_string:(function Some s -> s | None -> "") ~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 mk_path_helper
~setter:(fun var x -> var := x :: !var) ~setter:(fun var x -> var := x :: !var)
~decode_json:(list_json_decoder (string_json_decoder ~long)) ~decode_json:(list_json_decoder (string_json_decoder ~long))
~default_to_string:(String.concat ~sep:", ") ~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 strings = IList.map fst symbols in
let sym_to_str = IList.map (fun (x,y) -> (y,x)) 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 of_string str = IList.assoc String.equal str symbols in
let to_string sym = IList.assoc eq sym sym_to_str 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) ~default_to_string:(fun s -> to_string s)
~mk_setter:(fun var str -> var := of_string str) ~mk_setter:(fun var str -> var := of_string str)
~decode_json:(string_json_decoder ~long) ~decode_json:(string_json_decoder ~long)
~mk_spec:(fun set -> Symbol (strings, set)) ~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 strings = IList.map fst symbols in
let of_string str = IList.assoc String.equal str 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 _ -> "") ~default_to_string:(fun _ -> "")
~mk_setter:(fun var str -> var := Some (of_string str)) ~mk_setter:(fun var str -> var := Some (of_string str))
~decode_json:(string_json_decoder ~long) ~decode_json:(string_json_decoder ~long)
~mk_spec:(fun set -> Symbol (strings, set)) ~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 sym_to_str = IList.map (fun (x,y) -> (y,x)) symbols in
let of_string str = IList.assoc String.equal str 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 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)) ~default_to_string:(fun syms -> String.concat ~sep:" " (IList.map to_string syms))
~mk_setter:(fun var str_seq -> ~mk_setter:(fun var str_seq ->
var := IList.map of_string (Str.split (Str.regexp_string ",") 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) ~mk_spec:(fun set -> String set)
let mk_set_from_json ~default ~default_to_string ~f let mk_set_from_json ~default ~default_to_string ~f
?(deprecated=[]) ~long ?short ?exes ?(meta="json") doc = ?(deprecated=[]) ~long ?short ?parse_mode ?(meta="json") doc =
mk ~deprecated ~long ?short ?exes ~meta doc mk ~deprecated ~long ?short ?parse_mode ~meta doc
~default ~default_to_string ~default ~default_to_string
~mk_setter:(fun var json -> var := f (Yojson.Basic.from_string json)) ~mk_setter:(fun var json -> var := f (Yojson.Basic.from_string json))
~decode_json:(fun json -> [dashdash long; Yojson.Basic.to_string json]) ~decode_json:(fun json -> [dashdash long; Yojson.Basic.to_string json])
~mk_spec:(fun set -> String set) ~mk_spec:(fun set -> String set)
let mk_json ?(deprecated=[]) ~long ?short ?exes ?(meta="json") doc = let mk_json ?(deprecated=[]) ~long ?short ?parse_mode ?(meta="json") doc =
mk ~deprecated ~long ?short ?exes ~meta doc mk ~deprecated ~long ?short ?parse_mode ~meta doc
~default:(`List []) ~default_to_string:Yojson.Basic.to_string ~default:(`List []) ~default_to_string:Yojson.Basic.to_string
~mk_setter:(fun var json -> var := Yojson.Basic.from_string json) ~mk_setter:(fun var json -> var := Yojson.Basic.from_string json)
~decode_json:(fun json -> [dashdash long; Yojson.Basic.to_string json]) ~decode_json:(fun json -> [dashdash long; Yojson.Basic.to_string json])
~mk_spec:(fun set -> String set) ~mk_spec:(fun set -> String set)
(** A ref to a function used during argument parsing to process anonymous arguments. By default, (** [mk_anon] always return the same ref. Anonymous arguments are only accepted if
anonymous arguments are rejected. *) [parse_action_accept_unknown_args] is true. *)
let anon_fun = ref (fun arg -> raise (Arg.Bad ("unexpected anonymous argument: " ^ arg))) let mk_anon () = rev_anon_args
(** Clients declare that anonymous arguments are acceptable by calling [mk_anon], which returns a let mk_rest ?(parse_mode=Infer []) doc =
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 rest = ref [] in let rest = ref [] in
let spec = Rest (fun arg -> rest := arg :: !rest) in let spec = Rest (fun arg -> rest := arg :: !rest) in
add exes {long = "--"; short = ""; meta = ""; doc; spec; decode_json = fun _ -> []} ; add parse_mode {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 _ -> []} ;
rest rest
let set_curr_speclist_for_parse_action ~incomplete ~usage parse_action =
let decode_inferconfig_to_argv current_exe path = let full_speclist = ref [] in
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 curr_usage status = let curr_usage status =
prerr_endline (String.concat_array ~sep:" " !args_to_parse) ; prerr_endline (String.concat_array ~sep:" " !args_to_parse) ;
Arg.usage !curr_speclist usage_msg ; Arg.usage !curr_speclist usage ;
exit status exit status
and full_usage status = and full_usage status =
Arg.usage (convert_speclist !full_speclist) usage_msg ; Arg.usage (to_arg_speclist !full_speclist) usage ;
exit status exit status
in 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 (* "-help" and "--help" are automatically recognized by Arg.parse, so we have to give them special
treatment *) treatment *)
let add_or_suppress_help (speclist, (doc_width,left_width)) = 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 = let mk_spec ~long ?(short="") spec doc =
pad_and_xform doc_width left_width { long; short; meta=""; spec; doc; pad_and_xform doc_width left_width { long; short; meta=""; spec; doc;
decode_json=fun _ -> raise (Arg.Bad long)} in 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 @ [ speclist @ [
(unknown "--help") ; (unknown "--help") ;
(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 let sort speclist = IList.sort compare_specs speclist in
align (sort speclist) align (sort speclist)
in 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 = let mk_header_spec heading =
("", Unit (fun () -> ()), "\n " ^ heading ^ "\n") in ("", 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, widths) = normalize !exe_descs in
let exe_speclist = if add_help let exe_speclist = if add_help
then add_or_suppress_help (exe_speclist, widths) then add_or_suppress_help (exe_speclist, widths)
else exe_speclist in 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 (* 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, 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. *) 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 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 @ curr_speclist := IList.filter (is_not_dup_with_doc unique_exe_speclist) !curr_speclist @
(match header with (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) | None -> unique_exe_speclist)
in in
(* speclist includes args for current exe with docs, and all other args without docs, so (* 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 *) current exe *)
(* reset the speclist between calls to this function *) (* reset the speclist between calls to this function *)
curr_speclist := []; curr_speclist := [];
if equal_exe current_exe Driver then ( if equal_parse_action parse_action (Infer Driver) then (
add_to_curr_speclist ~add_help:true ~header:"Driver options" current_exe; add_to_curr_speclist ~add_help:true ~header:"Driver options" (Infer Driver);
add_to_curr_speclist ~header:"Analysis (backend) options" Analyze; add_to_curr_speclist ~header:"Analysis (backend) options" (Infer Analysis);
add_to_curr_speclist ~header:"Clang frontend options" Clang add_to_curr_speclist ~header:"Clang frontend options" (Infer Clang)
) else ) 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 ) 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) 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 exe_name = Sys.executable_name in
let env_cl_args = args_to_parse := Array.of_list (exe_name :: 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);
arg_being_parsed := 0; 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 *) (* 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 let is_unknown msg = String.is_substring msg ~substring:": unknown option" in
accept_unknown_args := false ;
let rec parse_loop () = let rec parse_loop () =
try try
Arg.parse_argv_dynamic ~current:arg_being_parsed !args_to_parse curr_speclist Arg.parse_argv_dynamic ~current:arg_being_parsed !args_to_parse curr_speclist
(fun arg -> !anon_fun arg) usage_msg anon_fun usage
with with
| Arg.Bad _ when incomplete -> parse_loop () | Arg.Bad _ when incomplete -> parse_loop ()
| Arg.Bad msg when !accept_unknown_args && is_unknown msg -> | Arg.Bad usage_msg ->
!anon_fun !args_to_parse.(!arg_being_parsed); if !unknown_args_action <> `Reject && is_unknown usage_msg then (
parse_loop () anon_fun !args_to_parse.(!arg_being_parsed);
| Arg.Bad usage_msg -> Pervasives.prerr_string usage_msg; exit 2 parse_loop ()
) else (
Pervasives.prerr_string usage_msg;
exit 2
)
| Arg.Help usage_msg -> Pervasives.print_string usage_msg; exit 0 | Arg.Help usage_msg -> Pervasives.print_string usage_msg; exit 0
in in
parse_loop (); 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 *) (* reread args_to_parse instead of using all_args since mk_path_helper may have modified them *)
let prog_args = let prog_args =
List.rev_append 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 (List.rev !extra_env_args) in
(* do not include program path in args passed via env var *) (* do not include program path in args passed via env var *)
let args = Option.value (List.tl prog_args) ~default:[] in 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 curr_usage

58
infer/src/base/CommandLineOption.mli
Unescape View File

@ -22,6 +22,17 @@ val exe_name : exe -> string
val frontend_exes: exe list 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 is_originator : bool
val init_work_dir : string 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 - [f] specifies a transformation to be performed on the parsed value before setting the config
variable variable
- [symbols] is an association list sometimes used in place of [f] - [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 - [parse_mode] declares which parse mode the option is for. In the case of Infer, that includes
each [exe] in [exes], otherwise it appears only in --help-full 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 - [meta] is a meta-variable naming the parsed value for documentation purposes
- a documentation string - a documentation string
*) *)
type 'a t = type 'a t =
?deprecated:string list -> long:string -> ?short:string -> ?deprecated:string list -> long:string -> ?short:string ->
?exes:exe list -> ?meta:string -> string -> ?parse_mode:parse_mode -> ?meta:string -> string ->
'a 'a
(** [mk_set variable value] defines a command line option which sets [variable] to [value]. *) (** [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 (** [mk_anon ()] defines a [string list ref] of the anonymous command line arguments, in the reverse
order they appeared on the command line. *) order they appeared on the command line. *)
val mk_anon : val mk_anon : unit -> string list ref
unit ->
string list ref
(** [mk_rest doc] defines a [string list ref] of the command line arguments following ["--"], in the (** [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 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]. *) [exe -opt1 -opt2 -- arg1 arg2] will result in the returned ref containing [arg2; arg1]. *)
val mk_rest : val mk_rest :
?exes:exe list -> string -> ?parse_mode:parse_mode -> string ->
string list ref string list ref
(** [mk_subcommand doc command_to_speclist] defines a [string list ref] of the command line (** [mk_rest_actions doc ~usage command_to_parse_action] defines a [string list ref] of the command
arguments following ["--"], in the reverse order they appeared on the command line. For line arguments following ["--"], in the reverse order they appeared on the command line. [usage]
example, calling [mk_subcommand] and parsing [exe -opt1 -opt2 -- arg1 arg2] will result in the is the usage message in case of parse errors or if --help is passed. For example, calling
returned ref containing [arg2; arg1]. Additionally, the first arg following ["--"] is passed to [mk_action] and parsing [exe -opt1 -opt2 -- arg1 arg2] will result in the returned ref
[command_to_speclist] to obtain a list of argument action specifications used when parsing the containing [arg2; arg1]. Additionally, the first arg following ["--"] is passed to
remaining arguments. *) [command_to_parse_action] to obtain the parse action that will be used to parse the remaining
val mk_subcommand : arguments. *)
?exes:exe list -> string -> val mk_rest_actions :
(string -> (Arg.key * Arg.spec * Arg.doc) list) -> ?parse_mode:parse_mode -> string ->
string list ref usage:string -> (string -> parse_action)
-> string list ref
(** environment variable use to pass arguments from parent to child processes *) (** environment variable use to pass arguments from parent to child processes *)
val args_env_var : string 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] *) (** [extend_env_args args] appends [args] to those passed via [args_env_var] *)
val extend_env_args : string list -> unit 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. [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 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 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 specified in the environment variable, which themselves supersede those passed via the config
file. file.
If [incomplete] is set, unknown options are ignored, and [args_env_var] is not set. 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, 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 the environment variable, and the command line. The [args_env_var] is set to the set of options
options parsed. *) parsed in [args_env_var] and on the command line. *)
val parse : ?incomplete:bool -> ?config_file:string -> 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 *) (** [is_env_var_set var] is true if $[var]=1 *)
val is_env_var_set : string -> bool val is_env_var_set : string -> bool

260
infer/src/base/Config.ml
Unescape View File

@ -247,7 +247,7 @@ let real_exe_name =
let current_exe = let current_exe =
if !Sys.interactive then CLOpt.Interactive if !Sys.interactive then CLOpt.Interactive
else try IList.assoc String.equal (Filename.basename real_exe_name) CLOpt.exes 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 = let bin_dir =
Filename.dirname real_exe_name 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 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 let exe_usage = match (current_exe : CLOpt.exe) with
| Clang | Interactive -> false | Analyze ->
| Analyze | Driver | Print -> true) && version_string ^ "\n" ^
not maven "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 *) (* Declare the phase 1 options *)
let inferconfig_home = let inferconfig_home =
let all_exes = IList.map snd CLOpt.exes in
CLOpt.mk_path_opt ~long:"inferconfig-home" 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 = and project_root =
CLOpt.mk_path ~deprecated:["project_root"; "-project_root"] ~long:"project-root" ~short:"pr" CLOpt.mk_path ~deprecated:["project_root"; "-project_root"] ~long:"project-root" ~short:"pr"
~default:CLOpt.init_work_dir ~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" ~meta:"dir" "Specify the root directory of the project"
(* Parse the phase 1 options, ignoring the rest *) (* 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 *) (* 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 can be defined together sharing a reference. See debug and specs_library below for two
different examples. *) different examples. *)
let anon_args = let anon_args = CLOpt.mk_anon ()
CLOpt.mk_anon ()
and abs_struct = and abs_struct =
CLOpt.mk_int ~deprecated:["absstruct"] ~long:"abs-struct" ~default:1 CLOpt.mk_int ~deprecated:["absstruct"] ~long:"abs-struct" ~default:1
@ -413,7 +437,7 @@ and (
ignore ( ignore (
let long = "<analyzer>-" ^ suffix in let long = "<analyzer>-" ^ suffix in
CLOpt.mk_string_list ~long ~meta ~f:(fun _ -> raise (Arg.Bad "invalid option")) CLOpt.mk_string_list ~long ~meta ~f:(fun _ -> raise (Arg.Bad "invalid option"))
~exes:CLOpt.[Driver;Print] ~parse_mode:CLOpt.(Infer [Driver;Print])
help help
); );
IList.map (fun (name, analyzer) -> (analyzer, mk_option name)) string_to_analyzer in 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 | Capture | Compile | Infer | Eradicate | Checkers | Tracing | Crashcontext | Linters
| Quandary | Threadsafety | Bufferoverrun -> () in | Quandary | Threadsafety | Bufferoverrun -> () in
CLOpt.mk_symbol_opt ~deprecated:["analyzer"] ~long:"analyzer" ~short:"a" 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\ "Specify which analyzer to run (only one at a time is supported):\n\
- infer, eradicate, checkers, quandary, threadsafety, bufferoverrun: run the specified analysis\n\ - infer, eradicate, checkers, quandary, threadsafety, bufferoverrun: run the specified analysis\n\
- capture: run capture phase only (no analysis)\n\ - capture: run capture phase only (no analysis)\n\
@ -483,18 +507,18 @@ and ast_file =
and blacklist = and blacklist =
CLOpt.mk_string_opt ~deprecated:["-blacklist-regex";"-blacklist"] ~long:"buck-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 \ ~meta:"regex" "Skip analysis of files matched by the specified regular expression (Buck \
flavors only)" flavors only)"
and bootclasspath = and bootclasspath =
CLOpt.mk_string_opt ~long:"bootclasspath" CLOpt.mk_string_opt ~long:"bootclasspath"
~exes:CLOpt.[Driver] ~parse_mode:CLOpt.(Infer [Driver])
"Specify the Java bootclasspath" "Specify the Java bootclasspath"
and bo_debug = and bo_debug =
CLOpt.mk_int ~default:0 ~long:"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 *) (** Automatically set when running from within Buck *)
and buck = and buck =
@ -503,55 +527,55 @@ and buck =
and buck_build_args = and buck_build_args =
CLOpt.mk_string_list ~long:"Xbuck" 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)" "Pass values as command-line arguments to invocations of `buck build` (Buck flavors only)"
and buck_out = and buck_out =
CLOpt.mk_path_opt ~long:"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 = and bugs_csv =
CLOpt.mk_path_opt ~deprecated:["bugs"] ~long:"issues-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" ~meta:"file" "Write a list of issues in CSV format to a file"
and bugs_json = and bugs_json =
CLOpt.mk_path_opt ~deprecated:["bugs_json"] ~long:"issues-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" ~meta:"file" "Write a list of issues in JSON format to a file"
and bugs_tests = and bugs_tests =
CLOpt.mk_path_opt ~long:"issues-tests" CLOpt.mk_path_opt ~long:"issues-tests"
~exes:CLOpt.[Driver;Print] ~parse_mode:CLOpt.(Infer [Driver;Print])
~meta:"file" ~meta:"file"
"Write a list of issues in a format suitable for tests to a file" "Write a list of issues in a format suitable for tests to a file"
and bugs_txt = and bugs_txt =
CLOpt.mk_path_opt ~deprecated:["bugs_txt"] ~long:"issues-txt" CLOpt.mk_path_opt ~deprecated:["bugs_txt"] ~long:"issues-txt"
~exes:CLOpt.[Driver;Print] ~parse_mode:CLOpt.(Infer [Driver;Print])
~meta:"file" ~meta:"file"
"Write a list of issues in TXT format to a file" "Write a list of issues in TXT format to a file"
and bugs_xml = and bugs_xml =
CLOpt.mk_path_opt ~deprecated:["bugs_xml"] ~long:"issues-xml" CLOpt.mk_path_opt ~deprecated:["bugs_xml"] ~long:"issues-xml"
~exes:CLOpt.[Driver;Print] ~parse_mode:CLOpt.(Infer [Driver;Print])
~meta:"file" ~meta:"file"
"Write a list of issues in XML format to a file" "Write a list of issues in XML format to a file"
and calls_csv = and calls_csv =
CLOpt.mk_path_opt ~deprecated:["calls"] ~long:"calls-csv" CLOpt.mk_path_opt ~deprecated:["calls"] ~long:"calls-csv"
~exes:CLOpt.[Driver;Print] ~parse_mode:CLOpt.(Infer [Driver;Print])
~meta:"file" ~meta:"file"
"Write individual calls in CSV format to a file" "Write individual calls in CSV format to a file"
and changed_files_index = 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 \ "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" start. Source files should be specified relative to project root or be absolute"
and check_duplicate_symbols = and check_duplicate_symbols =
CLOpt.mk_bool ~long:"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." "Check if a symbol with the same name is defined in more than one file."
and checkers, crashcontext, eradicate, quandary, threadsafety, bufferoverrun = and checkers, crashcontext, eradicate, quandary, threadsafety, bufferoverrun =
@ -591,7 +615,7 @@ and checkers_repeated_calls =
"Check for repeated calls" "Check for repeated calls"
and clang_biniou_file = 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" "Specify a file containing the AST of the program, in biniou format"
and clang_compilation_db_files = and clang_compilation_db_files =
@ -600,7 +624,7 @@ and clang_compilation_db_files =
and clang_frontend_action = and clang_frontend_action =
CLOpt.mk_symbol_opt ~long:"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." "Specify whether the clang frontend should capture or lint or both."
~symbols:clang_frontend_action_symbols ~symbols:clang_frontend_action_symbols
@ -621,7 +645,7 @@ and cluster =
and compute_analytics = and compute_analytics =
CLOpt.mk_bool ~long:"compute-analytics" CLOpt.mk_bool ~long:"compute-analytics"
~default:false ~default:false
~exes:CLOpt.[Clang;Driver] ~parse_mode:CLOpt.(Infer [Clang;Driver])
"Emit analytics as info-level issues, like component kit line count and \ "Emit analytics as info-level issues, like component kit line count and \
component kit file cyclomatic complexity" component kit file cyclomatic complexity"
@ -629,13 +653,13 @@ and compute_analytics =
If a procedure was changed beforehand, keep the changed marking. *) If a procedure was changed beforehand, keep the changed marking. *)
and continue = and continue =
CLOpt.mk_bool ~deprecated:["continue"] ~long:"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 \ "Continue the capture for the reactive analysis, increasing the changed files/procedures. (If \
a procedure was changed beforehand, keep the changed marking.)" a procedure was changed beforehand, keep the changed marking.)"
and linters_ignore_clang_failures = and linters_ignore_clang_failures =
CLOpt.mk_bool ~long:"linters-ignore-clang-failures" CLOpt.mk_bool ~long:"linters-ignore-clang-failures"
~exes:CLOpt.[Driver] ~parse_mode:CLOpt.(Infer [Driver])
~default:false ~default:false
"Continue linting files even if some compilation fails." "Continue linting files even if some compilation fails."
@ -646,7 +670,7 @@ and copy_propagation =
and cxx = and cxx =
CLOpt.mk_bool ~deprecated:["cxx-experimental"] ~long:"cxx" CLOpt.mk_bool ~deprecated:["cxx-experimental"] ~long:"cxx"
~default:true ~default:true
~exes:CLOpt.[Clang] ~parse_mode:CLOpt.(Infer [Clang])
"Analyze C++ methods" "Analyze C++ methods"
and ( and (
@ -669,7 +693,7 @@ and (
and filtering = and filtering =
CLOpt.mk_bool ~long:"filtering" ~short:"f" ~default:true 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 \ "Do not show the results from experimental checks (note: some of them may contain many false \
alarms)" alarms)"
@ -705,7 +729,7 @@ and (
in in
let debug = let debug =
CLOpt.mk_bool_group ~deprecated:["debug"] ~long:"debug" ~short:"g" 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, \ "Debug mode (also sets --developer-mode, --no-filtering, --print-buckets, --print-types, \
--reports-include-ml-loc, --no-test, --trace-error, --write-dotty, --write-html)" --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; [developer_mode; print_buckets; print_types; reports_include_ml_loc; trace_error; write_html;
@ -739,7 +763,7 @@ and dependencies =
and disable_checks = and disable_checks =
CLOpt.mk_string_list ~deprecated:["disable_checks"] ~long:"disable-checks" ~meta:"error name" 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" "Do not show reports coming from this type of errors"
and dotty_cfg_libs = and dotty_cfg_libs =
@ -797,7 +821,7 @@ and err_file =
and fail_on_bug = and fail_on_bug =
CLOpt.mk_bool ~deprecated:["-fail-on-bug"] ~long:"fail-on-issue" ~default:false 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" (Printf.sprintf "Exit with error code %d if Infer found something to report"
fail_on_issue_exit_code) fail_on_issue_exit_code)
@ -819,13 +843,13 @@ and filter_paths =
and flavors = and flavors =
CLOpt.mk_bool ~deprecated:["-use-flavors"] ~long:"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 \ "Buck integration using Buck flavors (clang only), eg `infer --flavors -- buck build \
//foo:bar#infer`" //foo:bar#infer`"
and from_json_report = and from_json_report =
CLOpt.mk_path_opt ~long:"from-json-report" CLOpt.mk_path_opt ~long:"from-json-report"
~exes:CLOpt.[Print] ~parse_mode:CLOpt.(Infer [Print])
~meta:"report.json" ~meta:"report.json"
"Load analysis results from a report file (default is to load the results from the specs \ "Load analysis results from a report file (default is to load the results from the specs \
files generated by the analysis)." files generated by the analysis)."
@ -841,17 +865,17 @@ and frontend_stats =
and frontend_tests = and frontend_tests =
CLOpt.mk_bool ~long:"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" "Save filename.ext.test.dot with the cfg in dotty format for frontend tests"
and generated_classes = and generated_classes =
CLOpt.mk_path_opt ~long:"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" "Specify where to load the generated class files"
and headers = and headers =
CLOpt.mk_bool ~deprecated:["headers"] ~deprecated_no:["no_headers"] ~long:"headers" ~short:"hd" 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" "Analyze code in header files"
and icfg_dotty_outfile = 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)" ~meta:"dir" "Select a directory to contain the infer cache (Buck and Java only)"
and iphoneos_target_sdk_version = 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" "Specify the target SDK version to use for iphoneos"
and iterations = and iterations =
@ -880,7 +904,8 @@ and java_jar_compiler =
and jobs = and jobs =
CLOpt.mk_int ~deprecated:["-multicore"] ~long:"jobs" ~short:"j" ~default:ncpu 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 = and join_cond =
CLOpt.mk_int ~deprecated:["join_cond"] ~long:"join-cond" ~default:1 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" "Write a latex report of the analysis results to a file"
and linters_def_file = and linters_def_file =
CLOpt.mk_path_list ~default: [linters_def_default_file] CLOpt.mk_path_list ~default:[linters_def_default_file]
~long:"linters-def-file" ~exes:CLOpt.[Clang] ~long:"linters-def-file" ~parse_mode:CLOpt.(Infer [Clang])
~meta:"file" "Specify the file containing linters definition (e.g. 'linters.al')" ~meta:"file" "Specify the file containing linters definition (e.g. 'linters.al')"
and load_average = and load_average =
CLOpt.mk_float_opt ~long:"load-average" ~short:"l" 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 \ "Do not start new parallel jobs if the load average is greater than that specified (Buck and \
make only)" make only)"
and load_results = and load_results =
CLOpt.mk_path_opt ~deprecated:["load_results"] ~long:"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" ~meta:"file.iar" "Load analysis results from Infer Analysis Results file file.iar"
(** name of the makefile to create with clusters and dependencies *) (** name of the makefile to create with clusters and dependencies *)
@ -920,13 +945,13 @@ and margin =
and merge = and merge =
CLOpt.mk_bool ~deprecated:["merge"] ~long:"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)" "Merge the captured results directories specified in the dependency file (Buck flavors only)"
and ml_buckets = and ml_buckets =
CLOpt.mk_symbol_seq ~deprecated:["ml_buckets"; "-ml_buckets"] ~long:"ml-buckets" CLOpt.mk_symbol_seq ~deprecated:["ml_buckets"; "-ml_buckets"] ~long:"ml-buckets"
~default:[`MLeak_cf] ~default:[`MLeak_cf]
~exes:CLOpt.[Clang] ~parse_mode:CLOpt.(Infer [Clang])
"Specify the memory leak buckets to be checked in Objective-C/C++:\n\ "Specify the memory leak buckets to be checked in Objective-C/C++:\n\
- 'cf' checks leaks from Core Foundation,\n\ - 'cf' checks leaks from Core Foundation,\n\
- 'arc' from code compiled in ARC mode,\n\ - 'arc' from code compiled in ARC mode,\n\
@ -984,7 +1009,7 @@ and patterns_skip_translation =
and pmd_xml = and pmd_xml =
CLOpt.mk_bool ~long:"pmd-xml" CLOpt.mk_bool ~long:"pmd-xml"
~exes:CLOpt.[Driver] ~parse_mode:CLOpt.(Infer [Driver])
"Output issues in (PMD) XML format" "Output issues in (PMD) XML format"
and precondition_stats = and precondition_stats =
@ -992,7 +1017,7 @@ and precondition_stats =
"Print stats about preconditions to standard output" "Print stats about preconditions to standard output"
and print_logs = 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" "Also log messages to stdout and stderr"
and print_builtins = and print_builtins =
@ -1001,7 +1026,7 @@ and print_builtins =
and print_traces_in_tests = and print_traces_in_tests =
CLOpt.mk_bool ~long:"print-traces-in-tests" ~default:true 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" "Include symbolic traces summaries in the output of --issues-tests"
and print_using_diff = and print_using_diff =
@ -1020,7 +1045,7 @@ and procs_xml =
and progress_bar = and progress_bar =
CLOpt.mk_bool ~deprecated_no:["no_progress_bar"] ~long:"progress-bar" ~short:"pb" ~default:true 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" "Show a progress bar"
and quandary_sources = and quandary_sources =
@ -1030,8 +1055,8 @@ and quandary_sinks =
CLOpt.mk_json ~long:"quandary-sinks" "Specify custom sinks for Quandary" CLOpt.mk_json ~long:"quandary-sinks" "Specify custom sinks for Quandary"
and quiet = and quiet =
CLOpt.mk_bool ~long:"quiet" ~short:"q" ~default:(current_exe <> CLOpt.Print) CLOpt.mk_bool ~long:"quiet" ~short:"q" ~default:(current_exe <> (CLOpt.Print : CLOpt.exe))
~exes:CLOpt.[Print] ~parse_mode:CLOpt.(Infer [Print])
"Do not print specs on standard output" "Do not print specs on standard output"
and reactive = and reactive =
@ -1058,10 +1083,21 @@ and report_hook =
passed --issues-csv, --issues-json, --issues-txt, --issues-xml, --project-root, and \ passed --issues-csv, --issues-json, --issues-txt, --issues-xml, --project-root, and \
--results-dir." --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 = and results_dir =
CLOpt.mk_path ~deprecated:["results_dir"; "-out"] ~long:"results-dir" ~short:"o" CLOpt.mk_path ~deprecated:["results_dir"; "-out"] ~long:"results-dir" ~short:"o"
~default:(CLOpt.init_work_dir ^/ "infer-out") ~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" ~meta:"dir" "Write results and internal files in the specified directory"
and save_results = and save_results =
@ -1074,17 +1110,17 @@ and seconds_per_iteration =
and skip_analysis_in_path = and skip_analysis_in_path =
CLOpt.mk_string_list ~long:"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" ~meta:"path prefix" "Ignore files whose path matches the given prefix"
and skip_clang_analysis_in_path = and skip_clang_analysis_in_path =
CLOpt.mk_string_list ~long:"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" ~meta:"path prefix" "Ignore files whose path matches the given prefix"
and skip_translation_headers = and skip_translation_headers =
CLOpt.mk_string_list ~deprecated:["skip_translation_headers"] ~long:"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" ~meta:"path prefix" "Ignore headers whose path matches the given prefix"
and sources = and sources =
@ -1124,18 +1160,18 @@ and specs_library =
~long:"specs-library-index" ~long:"specs-library-index"
~default:"" ~default:""
~f:(fun file -> specs_library := (read_specs_dir_list_file file) @ !specs_library; "") ~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 "" in
specs_library specs_library
and stacktrace = 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 \ ~meta:"file" "File path containing a json-encoded Java crash stacktrace. Used to guide the \
analysis (only with '-a crashcontext'). See \ analysis (only with '-a crashcontext'). See \
tests/codetoanalyze/java/crashcontext/*.json for examples of the expected format." tests/codetoanalyze/java/crashcontext/*.json for examples of the expected format."
and stacktraces_dir = 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. \ ~meta:"dir" "Directory path containing multiple json-encoded Java crash stacktraces. \
Used to guide the analysis (only with '-a crashcontext'). See \ Used to guide the analysis (only with '-a crashcontext'). See \
tests/codetoanalyze/java/crashcontext/*.json for examples of the expected format." tests/codetoanalyze/java/crashcontext/*.json for examples of the expected format."
@ -1186,7 +1222,7 @@ and type_size =
and unsafe_malloc = and unsafe_malloc =
CLOpt.mk_bool ~long:"unsafe-malloc" CLOpt.mk_bool ~long:"unsafe-malloc"
~exes:CLOpt.[Analyze] ~parse_mode:CLOpt.(Infer [Analysis])
"Assume that malloc(3) never returns null." "Assume that malloc(3) never returns null."
and use_compilation_database = and use_compilation_database =
@ -1202,13 +1238,13 @@ and verbose_out =
and version = and version =
let var = ref `None in let var = ref `None in
CLOpt.mk_set var `Full ~deprecated:["version"] ~long:"version" 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" ; "Print version information and exit" ;
CLOpt.mk_set var `Json ~deprecated:["version_json"] ~long:"version-json" 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" ; "Print version information in json format and exit" ;
CLOpt.mk_set var `Vcs ~long:"version-vcs" 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" ; "Print version control system commit and exit" ;
var var
@ -1232,13 +1268,13 @@ and worklist_mode =
and xcode_developer_dir = and xcode_developer_dir =
CLOpt.mk_path_opt ~long:"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)" ~meta:"XCODE_DEVELOPER_DIR" "Specify the path to Xcode developer directory (Buck flavors only)"
and xcpretty = and xcpretty =
CLOpt.mk_bool ~long:"xcpretty" CLOpt.mk_bool ~long:"xcpretty"
~default:true ~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 \ "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)" 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" CLOpt.mk_bool ~deprecated:["xml"] ~long:"xml-specs"
"Export specs into XML files file1.xml ... filen.xml" "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 (* 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. *) 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 (* 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. *) Infer.run_javac for a version that looks inside argfiles, and discussion in D4397716. *)
let classes_out_spec = let javac_classes_out =
Arg.String (fun classes_out -> CLOpt.mk_string ~parse_mode:CLOpt.Javac
javac_classes_out := classes_out ; ~deprecated:["classes_out"] ~short:"d" ~long:"" ~default:CLOpt.init_work_dir
~f:(fun classes_out ->
if !buck then ( if !buck then (
let classes_out_infer = resolve classes_out ^/ buck_results_dir_name in 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 *) (* 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] ; CLOpt.extend_env_args ["--results-dir"; classes_out_infer] ;
results_dir := classes_out_infer results_dir := classes_out_infer;
) );
) in classes_out)
let classpath_spec = ""
Arg.String (fun classpath ->
and java_classpath =
CLOpt.mk_string_opt ~parse_mode:CLOpt.Javac
~deprecated:["classpath"] ~short:"cp" ~long:""
~f:(fun classpath ->
if !buck then ( if !buck then (
let paths = String.split classpath ~on:':' in let paths = String.split classpath ~on:':' in
let files = List.filter paths ~f:(fun path -> Sys.is_file path = `Yes) 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])) ; CLOpt.extend_env_args (List.concat_map files ~f:(fun file -> ["--specs-library"; file])) ;
specs_library := List.rev_append files !specs_library specs_library := List.rev_append files !specs_library
) );
) in classpath)
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, "")
]
| _ -> []
)
(** Parse Command Line Args *) and () =
CLOpt.mk_set ~parse_mode:CLOpt.Javac version
~deprecated:["version"] ~long:"" `Javac
""
let exe_usage (exe : CLOpt.exe) = (** Parse Command Line Args *)
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
let post_parsing_initialization () = let post_parsing_initialization () =
(match !version with (match !version with
@ -1318,8 +1329,15 @@ let post_parsing_initialization () =
| `Javac when !buck -> | `Javac when !buck ->
(* print buck key *) (* print buck key *)
let javac_version = 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 *) (* 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 let err = String.strip (In_channel.input_all chans.stderr) in
Unix.close_process_full chans |> ignore; Unix.close_process_full chans |> ignore;
err in err in
@ -1376,7 +1394,7 @@ let post_parsing_initialization () =
let parse_args_and_return_usage_exit = let parse_args_and_return_usage_exit =
let 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 () ; post_parsing_initialization () ;
usage_exit usage_exit

Write Preview
Loading…
Cancel
Save