diff --git a/infer/src/backend/inferanalyze.ml b/infer/src/backend/inferanalyze.ml index feac1f87c..bf688a0d0 100644 --- a/infer/src/backend/inferanalyze.ml +++ b/infer/src/backend/inferanalyze.ml @@ -149,7 +149,7 @@ let arg_desc = "-ml_buckets", Arg.Set_string ml_buckets_arg, Some "ml_buckets", "memory leak buckets to be checked, separated by commas. The possible buckets are cf (Core Foundation), arc, narc (No arc), cpp, unknown_origin"; ] in - Arg2.create_options_desc false "Analysis Options" desc in + Arg.create_options_desc false "Analysis Options" desc in let reserved_arg = let desc = reserved_arg_desc @ @@ -180,7 +180,8 @@ let arg_desc = "-print_buckets", Arg.Unit (fun() -> Config.show_buckets := true; Config.show_ml_buckets := true), None, "Add buckets to issue descriptions, useful when developing infer" ] in - Arg2.create_options_desc false "Reserved Options: Experimental features, use with caution!" desc in + Arg.create_options_desc false + "Reserved Options: Experimental features, use with caution!" desc in base_arg @ reserved_arg let usage = @@ -189,13 +190,13 @@ let usage = " Analyze the files captured in the project results directory, which can be specified with the -results_dir option." let print_usage_exit () = - Arg2.usage arg_desc usage; + Arg.usage arg_desc usage; exit(1) let () = (* parse command-line arguments *) let f arg = () (* ignore anonymous arguments *) in - Arg2.parse arg_desc f usage; + Arg.parse arg_desc f usage; if not (Sys.file_exists !Config.results_dir) then begin L.err "ERROR: results directory %s does not exist@.@." !Config.results_dir; diff --git a/infer/src/backend/inferprint.ml b/infer/src/backend/inferprint.ml index 1b32293d8..10af48236 100644 --- a/infer/src/backend/inferprint.ml +++ b/infer/src/backend/inferprint.ml @@ -115,7 +115,7 @@ let arg_desc = "-local_config", Arg.String (fun s -> Inferconfig.local_config := Some s), Some "Path", "Path to local config file"; ] in - Arg2.create_options_desc false "Options" desc in + Arg.create_options_desc false "Options" desc in let reserved_arg = let desc = [ @@ -127,7 +127,7 @@ let arg_desc = "-svg", Arg.Set svg, None, "generate .dot and .svg"; "-whole_seconds", Arg.Set whole_seconds, None, "print whole seconds only"; ] in - Arg2.create_options_desc false "Reserved Options" desc in + Arg.create_options_desc false "Reserved Options" desc in base_arg @ reserved_arg let usage = @@ -139,7 +139,7 @@ let usage = let print_usage_exit err_s = L.err "Load Error: %s@.@." err_s; - Arg2.usage arg_desc usage; + Arg.usage arg_desc usage; exit(1) (** return the list of the .specs files in the results dir and libs, if they're defined *) @@ -881,7 +881,7 @@ module AnalysisResults = struct if not (Filename.check_suffix arg ".specs") && arg <> "." then print_usage_exit "arguments must be .specs files" else args := arg::!args in - Arg2.parse arg_desc f usage; + Arg.parse arg_desc f usage; if !test_filtering then begin Inferconfig.test (); diff --git a/infer/src/backend/type_prop.ml b/infer/src/backend/type_prop.ml index e11306615..cc8b40467 100644 --- a/infer/src/backend/type_prop.ml +++ b/infer/src/backend/type_prop.ml @@ -714,14 +714,14 @@ let arg_desc = IList.mem string_equal option_name options_to_keep) arg_desc in let desc = (filter Utils.base_arg_desc) in - Utils.Arg2.create_options_desc false "Parsing Options" desc in + Utils.Arg.create_options_desc false "Parsing Options" desc in base_arg let usage = "Usage: Typeprop -results_dir out \n" let () = - Utils.Arg2.parse arg_desc (fun arg -> ()) usage + Utils.Arg.parse arg_desc (fun arg -> ()) usage (* Initialises the map of types of the methods that are never called with *) (* the static types. *) diff --git a/infer/src/backend/utils.ml b/infer/src/backend/utils.ml index 14f42f701..c376977e8 100644 --- a/infer/src/backend/utils.ml +++ b/infer/src/backend/utils.ml @@ -698,183 +698,9 @@ let reserved_arg_desc = ] (**************** START MODULE Arg2 -- modified from Arg in the ocaml distribution ***************) -module Arg2 = struct - type key = string - type doc = string - type usage_msg = string - type anon_fun = (string -> unit) - - type spec = Arg.spec - - exception Bad of string - exception Help of string - - type error = - | Unknown of string - | Wrong of string * string * string (* option, actual, expected *) - | Missing of string - | Message of string - - exception Stop of error (* used internally *) - - open Printf - - let rec assoc3 x l = - match l with - | [] -> raise Not_found - | (y1, y2, y3) :: t when y1 = x -> y2 - | _ :: t -> assoc3 x t - - let make_symlist prefix sep suffix l = - match l with - | [] -> "" - | h:: t -> (IList.fold_left (fun x y -> x ^ sep ^ y) (prefix ^ h) t) ^ suffix - - let print_spec buf (key, spec, doc) = - match spec with - | Arg.Symbol (l, _) -> bprintf buf " %s %s%s\n" key (make_symlist "{" "|" "}" l) - doc - | _ -> - let sep = if String.length doc != 0 && String.get doc 0 = '=' then "" else " " in - bprintf buf " %s%s%s\n" key sep doc - - let help_action () = raise (Stop (Unknown "-help")) - - let add_help speclist = - let add1 = - try ignore (assoc3 "-help" speclist); [] - with Not_found -> - ["-help", Arg.Unit help_action, " Display this list of options"] - and add2 = - try ignore (assoc3 "--help" speclist); [] - with Not_found -> - ["--help", Arg.Unit help_action, " Display this list of options"] - in - speclist @ (add1 @ add2) - - let usage_b buf speclist errmsg = - bprintf buf "%s\n" errmsg; - IList.iter (print_spec buf) (add_help speclist) - - let usage speclist errmsg = - let b = Buffer.create 200 in - usage_b b speclist errmsg; - eprintf "%s" (Buffer.contents b) - let current = ref 0;; - - let parse_argv ?(current = current) argv speclist anonfun errmsg = - let l = Array.length argv in - let b = Buffer.create 200 in - let initpos = !current in - let stop error = - let progname = if initpos < l then argv.(initpos) else "(?)" in - begin match error with - | Unknown "-help" -> () - | Unknown "--help" -> () - | Unknown s -> - bprintf b "%s: unknown option `%s'.\n" progname s - | Missing s -> - bprintf b "%s: option `%s' needs an argument.\n" progname s - | Wrong (opt, arg, expected) -> - bprintf b "%s: wrong argument `%s'; option `%s' expects %s.\n" - progname arg opt expected - | Message s -> - bprintf b "%s: %s.\n" progname s - end; - usage_b b speclist errmsg; - if error = Unknown "-help" || error = Unknown "--help" - then raise (Help (Buffer.contents b)) - else raise (Bad (Buffer.contents b)) - in - incr current; - while !current < l do - let s = argv.(!current) in - if String.length s >= 1 && String.get s 0 = '-' then begin - let action = - try assoc3 s speclist - with Not_found -> stop (Unknown s) - in - begin try - let rec treat_action = function - | Arg.Unit f -> f (); - | Arg.Bool f when !current + 1 < l -> - let arg = argv.(!current + 1) in - begin try f (bool_of_string arg) - with Invalid_argument "bool_of_string" -> - raise (Stop (Wrong (s, arg, "a boolean"))) - end; - incr current; - | Arg.Set r -> r := true; - | Arg.Clear r -> r := false; - | Arg.String f when !current + 1 < l -> - f argv.(!current + 1); - incr current; - | Arg.Symbol (symb, f) when !current + 1 < l -> - let arg = argv.(!current + 1) in - if IList.mem string_equal arg symb then begin - f argv.(!current + 1); - incr current; - end else begin - raise (Stop (Wrong (s, arg, "one of: " - ^ (make_symlist "" " " "" symb)))) - end - | Arg.Set_string r when !current + 1 < l -> - r := argv.(!current + 1); - incr current; - | Arg.Int f when !current + 1 < l -> - let arg = argv.(!current + 1) in - begin try f (int_of_string arg) - with Failure "int_of_string" -> - raise (Stop (Wrong (s, arg, "an integer"))) - end; - incr current; - | Arg.Set_int r when !current + 1 < l -> - let arg = argv.(!current + 1) in - begin try r := (int_of_string arg) - with Failure "int_of_string" -> - raise (Stop (Wrong (s, arg, "an integer"))) - end; - incr current; - | Arg.Float f when !current + 1 < l -> - let arg = argv.(!current + 1) in - begin try f (float_of_string arg); - with Failure "float_of_string" -> - raise (Stop (Wrong (s, arg, "a float"))) - end; - incr current; - | Arg.Set_float r when !current + 1 < l -> - let arg = argv.(!current + 1) in - begin try r := (float_of_string arg); - with Failure "float_of_string" -> - raise (Stop (Wrong (s, arg, "a float"))) - end; - incr current; - | Arg.Tuple specs -> - IList.iter treat_action specs; - | Arg.Rest f -> - while !current < l - 1 do - f argv.(!current + 1); - incr current; - done; - | _ -> raise (Stop (Missing s)) - in - treat_action action - with Bad m -> stop (Message m); - | Stop e -> stop e; - end; - incr current; - end else begin - (try anonfun s with Bad m -> stop (Message m)); - incr current; - end; - done - - let parse l f msg = - try - parse_argv Sys.argv l f msg; - with - | Bad msg -> eprintf "%s" msg; exit 2; - | Help msg -> printf "%s" msg; exit 0 +module Arg = struct + + include Arg (** Custom version of Arg.aling so that keywords are on one line and documentation is on the next *) let align arg_desc = @@ -893,9 +719,6 @@ module Arg2 = struct type aligned = (key * spec * doc) - let to_arg_desc x = x - let from_arg_desc x = x - (** Create a group of sorted command-line arguments *) let create_options_desc double_minus title unsorted_desc = let handle_double_minus (opname, spec, param_opt, text) = match param_opt with @@ -911,7 +734,7 @@ module Arg2 = struct IList.sort (fun (x, _, _) (y, _, _) -> Pervasives.compare x y) unsorted_desc' in align dlist end -(********** END OF MODULE Arg2 **********) +(********** END OF MODULE Arg **********) (** Escape a string for use in a CSV or XML file: replace reserved characters with escape sequences *) module Escape = struct diff --git a/infer/src/backend/utils.mli b/infer/src/backend/utils.mli index 589c4ff68..9bd832ba7 100644 --- a/infer/src/backend/utils.mli +++ b/infer/src/backend/utils.mli @@ -222,18 +222,11 @@ module SymOp : sig end (** Modified version of Arg module from the ocaml distribution *) -module Arg2 : sig - type spec = Arg.spec - - type key = string - type doc = string - type usage_msg = string - type anon_fun = (string -> unit) - - val current : int ref +module Arg : sig + include module type of Arg with type spec = Arg.spec (** type of aligned commend-line options *) - type aligned + type aligned = private (key * spec * doc) val align : (key * spec * doc) list -> aligned list @@ -241,9 +234,6 @@ module Arg2 : sig val usage : aligned list -> usage_msg -> unit - val to_arg_desc : aligned -> (key * spec * doc) - val from_arg_desc : (key * spec * doc) -> aligned - (** [create_options_desc double_minus unsorted_desc title] creates a group of sorted command-line arguments. [double_minus] is a booleand indicating whether the [-- option = nn] format or [- option n] format is to be used. [title] is the title of this group of options. diff --git a/infer/src/clang/cMain.ml b/infer/src/clang/cMain.ml index 357f4b7f4..1465c75c8 100644 --- a/infer/src/clang/cMain.ml +++ b/infer/src/clang/cMain.ml @@ -70,17 +70,17 @@ let arg_desc = None, "Mode for computing the models"; ] in - Utils.Arg2.create_options_desc false "Parsing Options" desc + Utils.Arg.create_options_desc false "Parsing Options" desc let usage = "\nUsage: InferClang -c C Files -ast AST Files -results_dir [options] \n" let print_usage_exit () = - Utils.Arg2.usage arg_desc usage; + Utils.Arg.usage arg_desc usage; exit(1) let () = - Utils.Arg2.parse arg_desc (fun arg -> ()) usage + Utils.Arg.parse arg_desc (fun arg -> ()) usage (* This function reads the json file in fname, validates it, and encoded in the AST data structure*) (* defined in Clang_ast_t. *) diff --git a/infer/src/java/jMain.ml b/infer/src/java/jMain.ml index 6c1d16921..d087c84a1 100644 --- a/infer/src/java/jMain.ml +++ b/infer/src/java/jMain.ml @@ -29,17 +29,17 @@ let arg_desc = "-verbose_out", Arg.String (fun path -> JClasspath.set_verbose_out path), None, "Set the path to the javac verbose output" ] in - Arg2.create_options_desc false "Parsing Options" desc + Arg.create_options_desc false "Parsing Options" desc let usage = "Usage: InferJava -d compilation_dir -sources filename\n" let print_usage_exit () = - Arg2.usage arg_desc usage; + Arg.usage arg_desc usage; exit(1) let () = - Arg2.parse arg_desc (fun arg -> ()) usage; + Arg.parse arg_desc (fun arg -> ()) usage; if Config.analyze_models && !JClasspath.models_jar <> "" then failwith "Not expecting model file when analyzing the models"; if not Config.analyze_models && !JClasspath.models_jar = "" then diff --git a/infer/src/llvm/lMain.ml b/infer/src/llvm/lMain.ml index 2206c83b5..68893e0e9 100644 --- a/infer/src/llvm/lMain.ml +++ b/infer/src/llvm/lMain.ml @@ -23,12 +23,12 @@ let arg_desc = None, "Enables debug mode" ] in - Arg2.create_options_desc false "Parsing Options" desc + Arg.create_options_desc false "Parsing Options" desc let usage = "Usage: InferLLVM -c [options]\n" let print_usage_exit () = - Utils.Arg2.usage arg_desc usage; + Utils.Arg.usage arg_desc usage; exit(1) let init_global_state source_filename = @@ -68,7 +68,7 @@ let store_tenv tenv = Sil.store_tenv_to_file tenv_filename tenv let () = - Arg2.parse arg_desc (fun arg -> ()) usage; + Arg.parse arg_desc (fun arg -> ()) usage; begin match !LConfig.source_filename with | None -> print_usage_exit () | Some source_filename -> init_global_state source_filename diff --git a/infer/src/scripts/checkCopyright.ml b/infer/src/scripts/checkCopyright.ml index b9a98a6a9..009924195 100644 --- a/infer/src/scripts/checkCopyright.ml +++ b/infer/src/scripts/checkCopyright.ml @@ -273,6 +273,6 @@ let () = let to_check = ref [] in let add_file_to_check fname = to_check := fname :: !to_check in - Arg.parse speclist add_file_to_check usage_msg; + Arg.parse (Arg.align speclist) add_file_to_check usage_msg; IList.iter check_copyright (IList.rev !to_check); exit 0