From 709376945f8079f33cf70ecf52a53ba077ef64f8 Mon Sep 17 00:00:00 2001 From: Jules Villard Date: Thu, 11 May 2017 10:10:01 -0700 Subject: [PATCH] [config] migrate help to use man pages Summary: Glorious, glorious man pages. This changes a bunch of things that were hard to break up from the diff, so the resulting diff is big. Use `Cmdliner.Manpage` to format man pages (and also format a bit ourselves since it is so stubborn). As a bonus, introduce the following subcommands: ``` infer run ... # same as default mode with -- before infer capture ... # -a capture infer compile ... # -a compile infer analyze ... # InferAnalyze infer report ... # InferPrint infer diff ... # this one is not new infer clang ... # InferClang, not that you should use it ``` The man pages can still be improved a lot. Notable missing sections: `ENVIRONMENT`, stuff about .inferconfig, some example usage, `DESCRIPTION`, ... Reviewed By: jberdine Differential Revision: D4921083 fbshipit-source-id: 9602230 --- infer/.merlin | 1 + infer/src/Makefile | 2 +- infer/src/backend/DifferentialFilters.ml | 4 +- infer/src/backend/InferAnalyzeExe.re | 2 +- infer/src/backend/InferPrint.re | 12 +- infer/src/backend/InferPrint.rei | 2 + infer/src/backend/InferPrintExe.re | 2 +- infer/src/backend/clusterMakefile.ml | 8 +- infer/src/backend/infer.ml | 11 +- infer/src/base/CommandDoc.ml | 272 ++++++++ infer/src/base/CommandDoc.mli | 19 + infer/src/base/CommandLineOption.ml | 690 ++++++++++----------- infer/src/base/CommandLineOption.mli | 108 +++- infer/src/base/Config.ml | 452 ++++++++------ infer/src/base/Config.mli | 15 +- infer/src/base/Logging.ml | 45 +- infer/src/base/Logging.mli | 2 +- infer/src/clang/Capture.re | 6 +- infer/src/integration/Buck.ml | 6 +- infer/src/integration/Javac.ml | 2 +- infer/src/integration/Maven.ml | 2 +- infer/src/unit/DifferentialFiltersTests.ml | 2 +- opam | 1 + opam.lock | 1 + scripts/toplevel_init | 1 + 25 files changed, 1036 insertions(+), 632 deletions(-) create mode 100644 infer/src/base/CommandDoc.ml create mode 100644 infer/src/base/CommandDoc.mli diff --git a/infer/.merlin b/infer/.merlin index 44ca55fad..dde3cb8b9 100644 --- a/infer/.merlin +++ b/infer/.merlin @@ -2,6 +2,7 @@ S src/** B _build/infer/** PKG ANSITerminal PKG atdgen +PKG cmdliner PKG core PKG javalib PKG oUnit diff --git a/infer/src/Makefile b/infer/src/Makefile index 0eb1fde56..9056c2ce6 100644 --- a/infer/src/Makefile +++ b/infer/src/Makefile @@ -40,7 +40,7 @@ OCAMLBUILD_OPTIONS = \ -tag-line "<*{clang/clang_ast_*,backend/jsonbug_*,checkers/stacktree_*}>: warn(-27-32-34-35-39)" \ -tag-line "<*/{,*/}*.{ml,re}{,i}>: package(ppx_compare)" \ -tag thread \ - -pkgs ANSITerminal,atdgen,core,extlib,oUnit,str,unix,xmlm,yojson,zip + -pkgs ANSITerminal,atdgen,cmdliner,core,extlib,oUnit,str,unix,xmlm,yojson,zip ifeq ($(ENABLE_OCAML_BINANNOT),yes) OCAMLBUILD_OPTIONS += -cflags -bin-annot diff --git a/infer/src/backend/DifferentialFilters.ml b/infer/src/backend/DifferentialFilters.ml index d466649a2..3aba7d8f9 100644 --- a/infer/src/backend/DifferentialFilters.ml +++ b/infer/src/backend/DifferentialFilters.ml @@ -182,7 +182,7 @@ let resolve_infer_eradicate_conflict let source_file = SourceFile.UNSAFE.from_string issue.file in let filters = filters_of_analyzer Config.Eradicate in filters.path_filter source_file in - Config.equal_analyzer analyzer Config.Infer && + Config.equal_analyzer analyzer Config.BiAbduction && String.equal issue.bug_type (Localise.to_issue_id Localise.null_dereference) && file_is_whitelisted () in let filter issues = List.filter ~f:(Fn.non should_discard_issue) issues in @@ -198,7 +198,7 @@ let do_filter ~(skip_duplicated_types: bool): Differential.t = if Config.filtering then ( diff - |> (if Config.equal_analyzer Config.analyzer Config.Infer then + |> (if Config.equal_analyzer Config.analyzer Config.BiAbduction then skip_anonymous_class_renamings else Fn.id) |> (if skip_duplicated_types then diff --git a/infer/src/backend/InferAnalyzeExe.re b/infer/src/backend/InferAnalyzeExe.re index 91a922f0e..7370f0aa7 100644 --- a/infer/src/backend/InferAnalyzeExe.re +++ b/infer/src/backend/InferAnalyzeExe.re @@ -28,7 +28,7 @@ let register_perf_stats_report () => { let () = { Logging.set_log_file_identifier - CommandLineOption.(Infer Analysis) (Option.map f::Filename.basename Config.cluster_cmdline); + CommandLineOption.Analyze (Option.map f::Filename.basename Config.cluster_cmdline); if Config.print_builtins { Builtin.print_and_exit () }; diff --git a/infer/src/backend/InferPrint.re b/infer/src/backend/InferPrint.re index 049676a8a..993405bd7 100644 --- a/infer/src/backend/InferPrint.re +++ b/infer/src/backend/InferPrint.re @@ -265,11 +265,11 @@ let should_report (issue_kind: Exceptions.err_kind) issue_type error_desc eclass switch Config.analyzer { | Eradicate | Tracing => true - | Capture + | BiAbduction + | CaptureOnly | Checkers - | Compile + | CompileOnly | Crashcontext - | Infer | Linters => false }; if analyzer_is_whitelisted { @@ -787,9 +787,7 @@ module Report = { module Summary = { let pp_summary_out summary => { let proc_name = Specs.get_proc_name summary; - if Config.quiet { - () - } else { + if (CLOpt.equal_command Config.command CLOpt.Report && not Config.quiet) { L.stdout "Procedure: %a@\n%a@." Typ.Procname.pp proc_name Specs.pp_summary_text summary } }; @@ -1313,3 +1311,5 @@ let main ::report_csv ::report_json => { }; print_issues formats_by_report_kind }; + +let main_from_config () => main report_csv::Config.bugs_csv report_json::Config.bugs_json; diff --git a/infer/src/backend/InferPrint.rei b/infer/src/backend/InferPrint.rei index 3aad2f9f6..df7929c86 100644 --- a/infer/src/backend/InferPrint.rei +++ b/infer/src/backend/InferPrint.rei @@ -9,3 +9,5 @@ open! IStd; let main: report_csv::option string => report_json::option string => unit; + +let main_from_config: unit => unit; diff --git a/infer/src/backend/InferPrintExe.re b/infer/src/backend/InferPrintExe.re index 3978523e2..b155ffe44 100644 --- a/infer/src/backend/InferPrintExe.re +++ b/infer/src/backend/InferPrintExe.re @@ -8,4 +8,4 @@ */ open! IStd; -let () = InferPrint.main report_csv::Config.bugs_csv report_json::Config.bugs_json; +let () = InferPrint.main_from_config (); diff --git a/infer/src/backend/clusterMakefile.ml b/infer/src/backend/clusterMakefile.ml index b5d623bd4..d55c43bbf 100644 --- a/infer/src/backend/clusterMakefile.ml +++ b/infer/src/backend/clusterMakefile.ml @@ -24,8 +24,8 @@ let pp_prolog fmt clusters = let compilation_dbs_cmd = List.map ~f:infer_flag_of_compilation_db !Config.clang_compilation_dbs |> String.concat ~sep:" " |> escape in - F.fprintf fmt "INFERANALYZE= %s --results-dir '%s' %s \n@." - (Config.bin_dir ^/ (Config.exe_name Analyze)) + F.fprintf fmt "INFERANALYZE = '%s' --results-dir '%s' %s@\n@\n" + (Config.(bin_dir ^/ infer_analyze_exe_name)) (escape Config.results_dir) compilation_dbs_cmd; F.fprintf fmt "CLUSTERS="; @@ -35,8 +35,8 @@ let pp_prolog fmt clusters = F.fprintf fmt "%a " Cluster.pp_cluster_name (i+1)) clusters; - F.fprintf fmt "@.@.default: test@.@.all: test@.@."; - F.fprintf fmt "test: $(CLUSTERS)@."; + F.fprintf fmt "@\n@\ndefault: test@\n@\nall: test@\n@\n"; + F.fprintf fmt "test: $(CLUSTERS)@\n"; if Config.show_progress_bar then F.fprintf fmt "\t@@echo@\n@." let pp_epilog fmt () = diff --git a/infer/src/backend/infer.ml b/infer/src/backend/infer.ml index ace774c9f..5833f81b5 100644 --- a/infer/src/backend/infer.ml +++ b/infer/src/backend/infer.ml @@ -373,9 +373,9 @@ let analyze driver_mode = | _ when Config.maven -> (* Called from Maven, only do capture. *) false, false - | _, (Capture | Compile) -> + | _, (CaptureOnly | CompileOnly) -> false, false - | _, (Infer | Eradicate | Checkers | Tracing | Crashcontext) -> + | _, (BiAbduction | Checkers | Crashcontext | Eradicate | Tracing) -> true, true | _, Linters -> false, true in @@ -493,7 +493,7 @@ let infer_mode () = remove_results_dir () ; create_results_dir () ; (* re-set log files, as default files were in results_dir removed above *) - if not Config.buck_cache_mode then L.set_log_file_identifier CLOpt.(Infer Driver) None; + if not Config.buck_cache_mode then L.set_log_file_identifier CLOpt.Run None; if Config.print_builtins then Builtin.print_and_exit () ; if CLOpt.is_originator then L.do_out "%s@\n" Config.version_string ; if Config.debug_mode || Config.stats_mode then log_infer_args driver_mode ; @@ -545,6 +545,7 @@ let differential_mode () = Differential.to_files diff out_path let () = - match Config.final_parse_action with - | Differential -> differential_mode () + match Config.command with + | Report -> InferPrint.main_from_config () + | ReportDiff -> differential_mode () | _ -> infer_mode () diff --git a/infer/src/base/CommandDoc.ml b/infer/src/base/CommandDoc.ml new file mode 100644 index 000000000..cff7ab7da --- /dev/null +++ b/infer/src/base/CommandDoc.ml @@ -0,0 +1,272 @@ +(* + * Copyright (c) 2017 - present Facebook, Inc. + * All rights reserved. + * + * This source code is licensed under the BSD style license found in the + * LICENSE file in the root directory of this source tree. An additional grant + * of patent rights can be found in the PATENTS file in the same directory. + *) +open! IStd + +module CLOpt = CommandLineOption + +type data = { long: string; command_doc: CLOpt.command_doc } + +let inferconfig_env_var = "INFERCONFIG" + +(** Name of the infer configuration file *) +let inferconfig_file = ".inferconfig" + +let command_to_long = CLOpt.[ + Analyze, "analyze"; Capture, "capture"; Clang, "clang"; Compile, "compile"; Report, "report"; + ReportDiff, "reportdiff"; Run, "run"; + ] + +let long_of_command = + List.Assoc.find_exn ~equal:CLOpt.equal_command command_to_long + +let exe_name_of_command cmd = + let long = long_of_command cmd in + (* InferClang is special because it's not really a user-facing executable *) + if CLOpt.equal_command cmd CLOpt.Clang then "InferClang" + else "infer-" ^ long + +let mk_command_doc ~see_also:see_also_commands ?and_also ?environment:environment_opt + ?files:files_opt ~synopsis = + let section = 1 in + let see_also = + let exe_names = List.map see_also_commands ~f:(fun cmd -> + let exe = exe_name_of_command cmd in + Printf.sprintf "$(b,%s)(%d)" (Cmdliner.Manpage.escape exe) section) in + let suffix = match and_also with None -> "" | Some msg -> " " ^ msg in + [`P (String.concat ~sep:", " exe_names ^ suffix)] in + let environment = Option.value environment_opt + ~default:[`I (Printf.sprintf "$(b,%s), $(b,%s), $(b,%s)" + CLOpt.args_env_var inferconfig_env_var CLOpt.strict_mode_env_var, + Printf.sprintf "See the %s section in the manual of $(b,infer)(%d)." + Cmdliner.Manpage.s_environment section)] in + let files = Option.value files_opt + ~default:[`I (Printf.sprintf "$(b,%s)" inferconfig_file, + Printf.sprintf "See the %s section in the manual of $(b,infer)(%d)." + Cmdliner.Manpage.s_files section)] in + CLOpt.mk_command_doc ~section ~version:Version.versionString + ~date:Version.man_pages_last_modify_date ~synopsis:[`Pre synopsis] ~environment ~files ~see_also + +let analyze = + mk_command_doc ~title:"Infer Analysis" + ~short_description:"analyze the files captured by infer" + ~synopsis:"$(b,infer) $(b,analyze) $(i,[options])\n\ + $(b,infer) $(i,[options])" + ~description:[`P "Analyze the files captured in the project results directory and report."] + ~see_also:CLOpt.[Report; Run] + +let capture = + mk_command_doc ~title:"Infer Compilation Capture" + ~short_description:"capture source files for later analysis" + ~synopsis:"$(b,infer) $(b,capture) $(i,[options]) $(b,--) $(b,buck) $(i,...)\n\ + $(b,infer) $(b,capture) $(b,--flavors) $(i,[options]) $(b,--) $(b,buck) $(i,...)\n\ + $(b,infer) $(b,capture) $(b,--buck-compilation-database) $(i,[no-]deps) \ + $(i,[options]) $(b,--) $(b,buck) $(i,...)\n\ + $(b,infer) $(b,capture) $(i,[options]) $(b,--compilation-database) $(i,file)\n\ + $(b,infer) $(b,capture) $(i,[options]) $(b,--compilation-database-escaped) \ + $(i,file)\n\ + $(b,infer) $(b,capture) $(i,[options]) $(b,--) $(b,gradle)/$(b,gradlew) \ + $(i,...)\n\ + $(b,infer) $(b,capture) $(i,[options]) $(b,--) $(b,javac) $(i,...)\n\ + $(b,infer) $(b,capture) $(i,[options]) $(b,--) $(b,make)/$(b,clang)/$(b,gcc) \ + $(i,...)\n\ + $(b,infer) $(b,capture) $(i,[options]) $(b,--) $(b,mvn)/$(b,mvnw) \ + $(i,...)\n\ + $(b,infer) $(b,capture) $(i,[options]) $(b,--) $(b,ndk-build) $(i,...)\n\ + $(b,infer) $(b,capture) $(i,[--no-xcpretty]) $(i,[options]) $(b,--) \ + $(b,xcodebuild) $(i,...)" + ~description:[ + `P "Capture the build command or compilation database specified on the command line: infer \ + intercepts calls to the compiler to read source files, translate them into infer's \ + intermediate representation, and store the result of the translation in the results \ + directory."; + ] + ~see_also:CLOpt.[Analyze;Compile;Run] + +let clang = + mk_command_doc ~title:"Infer Clang Capture" + ~short_description:"internal tool to capture clang commands" + ~synopsis:"$(b,InferClang) $(i,[clang options])" + ~description:[`P "This is used internally by other infer commands. You shouldn't need to call \ + this directly."] + ~options:[`P "Accepts the same command line options as $(b,clang)(1) (but still reads infer \ + options from the environment)."] + ~see_also:CLOpt.[Capture] + +let compile = + mk_command_doc ~title:"Infer Project Compilation" + ~short_description:"compile project from within the infer environment" + ~synopsis:"$(b,infer) $(b,compile) $(b,--) $(i,[compile command])" + ~description:[ + `P "Intercepts compilation commands similarly to $(b,infer-capture), but simply execute \ + these compilation commands and do not perform any translation of the source files. This \ + can be useful to configure build systems or for debugging purposes."; + ] + ~examples:[ + `P "$(b,cmake)(1) hardcodes the absolute paths to the compiler inside the Makefiles it \ + generates, which defeats the later capture of compilation commands by infer. Thus, to \ + capture a CMake project, one should configure the project from within the infer build \ + environment, for instance:"; + `Pre " \ + mkdir build && cd build\n \ + infer compile -- cmake ..\n \ + infer capture -- make"; + `P "The same solution can be used for projects whose \"./configure\" script hardcodes the \ + paths to the compilers, for instance:"; + `Pre " \ + infer compile -- ./configure\n \ + infer capture -- make"; + `P "Another solution for CMake projects is to use CMake's compilation databases, for \ + instance:"; + `Pre " \ + mkdir build && cd build\n \ + cmake -DCMAKE_EXPORT_COMPILE_COMMANDS=1 ..\n \ + infer capture --compilation-database compile_commands.json"; + ] + ~see_also:CLOpt.[Capture] + +let infer = mk_command_doc ~title:"Infer Static Analyzer" + ~short_description:"static analysis for Java and C/C++/Objective-C/Objective-C++" + ~synopsis:"$(b,infer) $(b,analyze) $(i,[options])\n\ + $(b,infer) $(b,capture) $(i,[options])\n\ + $(b,infer) $(b,compile) $(i,[options])\n\ + $(b,infer) $(b,report) $(i,[options])\n\ + $(b,infer) $(b,reportdiff) $(i,[options])\n\ + $(b,infer) $(b,run) $(i,[options])\n\ + $(b,infer) $(b,--compilation-database[-escaped]) $(i,file) $(i,[options])\n\ + $(b,infer) $(i,[options]) $(b,--) $(b,compile command)\n\ + $(b,infer) $(i,[options])" + ~description:[ + `P "Infer is a static analyzer. Given a collection of source files written in Java or in \ + languages of the C family, and a command to build them, infer produces a list of \ + potential issues."; + `P "Infer consists of a collection of tools referenced in the $(i,SEE ALSO) section of this \ + manual. See their respective manuals for more information about each."; + ] + ~options:[ + `P "If a compilation command is specified via the $(b,--) option or one of the \ + $(b,--clang-compilation-database[-escaped]) options, $(b,infer) behaves as \ + $(b,infer-run)(1). Otherwise, $(b,infer) behaves as $(b,infer-analyze)(1)."; + `P "See the manuals of individual infer commands for details about their supported options."; + `P "Every infer command accepts the arguments from all the other infer commands. The same \ + option may affect and thus be list in the manual of several commands."; + `P (Printf.sprintf + "Options are read from the $(b,%s) file, then from the $(b,%s) environment variable, \ + then from the command line. Options in $(b,%s) take precedence over options in \ + $(b,%s), and options passed on the command line take precedence over options in \ + $(b,%s). See the $(i,%s) and $(i,%s) sections of this manual for more information." + inferconfig_file CLOpt.args_env_var + CLOpt.args_env_var + inferconfig_file + CLOpt.args_env_var Cmdliner.Manpage.s_environment Cmdliner.Manpage.s_files + ); + ] + ~environment:[ + `P (Printf.sprintf + "Extra arguments may be passed to all infer commands using the $(b,%s) \ + environment variable (see the $(i,%s) section). $(b,%s) is expected to contain a \ + string of %c-separated options. For instance, calling `%s=--debug^--print-logs infer` \ + is equivalent to calling `infer --debug --print-logs`." + CLOpt.args_env_var + Cmdliner.Manpage.s_options CLOpt.args_env_var + CLOpt.env_var_sep CLOpt.args_env_var + ); + `P (Printf.sprintf + "$(b,%s): Tells infer where to find the %s file. (See the %s section)" + inferconfig_env_var inferconfig_file Cmdliner.Manpage.s_files + ); + `P (Printf.sprintf + "If $(b,%s) is set to \"1\", then infer commands will exit with an error code in some \ + cases when otherwise a simple warning would be emitted on stderr, for instance if a \ + deprecated form of an option is used." + CLOpt.strict_mode_env_var + ); + ] + ~files:[ + `P (Printf.sprintf + "$(b,%s) can be used to store infer options. Its format is that of a JSON \ + record, where fields are infer long-form options, without their leading \"--\", and \ + values depend on the type of the option:" inferconfig_file); + `Noblank; + `P "- for switches options, the value is a JSON boolean (true or false, without quotes)"; + `Noblank; + `P "- for integers, the value is a JSON integer (without quotes)"; + `Noblank; + `P "- string options have string values"; + `Noblank; + `P (Printf.sprintf "- path options have string values, and are interpreted relative to the \ + location of the %s file" inferconfig_file); + `Noblank; + `P "- cumulative options are JSON arrays of the appropriate type"; + `P (Printf.sprintf "Infer will look for an $(b,%s) file in the current directory, then its \ + parent, etc., stopping at the first $(b,%s) file found." + inferconfig_file inferconfig_file); + `P "Example:"; + `Pre " {\ + \n \"cxx\": false,\ + \n \"infer-blacklist-files-containing\": [\"@generated\",\"@Generated\"]\ + \n }"; + ] + ~see_also:(List.filter ~f:(function | CLOpt.Clang -> false | _ -> true) CLOpt.all_commands) + ~and_also:", $(b,inferTraceBugs)" + "infer" + +let report = + mk_command_doc ~title:"Infer Reporting" + ~short_description:"compute and manipulate infer results" + ~synopsis:"$(b,infer) $(b,report) $(i,[options]) [$(i,file.specs)...]" + ~description:[ + `P "Read, convert, and print .specs files in the results directory. Each spec is printed to \ + standard output unless option -q is used."; + `P "If no specs file are passed on the command line, process all the .specs in the results \ + directory."; + ] + ~see_also:CLOpt.[ReportDiff; Run] + +let reportdiff = + mk_command_doc ~title:"Infer Report Difference" + ~short_description:"compute the differences between two infer reports" + ~synopsis:"$(b,infer) $(b,reportdiff) $(b,--report-current) $(i,file) \ + $(b,--report-previous) $(i,file) $(i,[options])" + ~description:[ + `P "Given two infer reports $(i,previous) and $(i,current), compute the following three \ + reports and store them inside the \"differential/\" subdirectory of the results \ + directory:"; + `Noblank; `P "- $(b,introduced.json) contains the issues found in $(i,current) but not \ + $(i,previous);"; + `Noblank; `P "- $(b,fixed.json) contains the issues found in $(i,previous) but not \ + $(i,current);"; + `Noblank; `P "- $(b,preexisting.json) contains the issues found in both $(i,previous) and \ + $(i,current)."; + `P "All three files follow the same format as normal infer reports."; + ] + ~see_also:CLOpt.[Report] + +let run = + mk_command_doc ~title:"Infer Analysis of a Project" + ~short_description:"capture source files, analyze, and report" + ~synopsis:"$(b,infer) $(b,run) $(i,[options])\n\ + $(b,infer) $(i,[options]) $(b,--) $(i,compile command)" + ~description:[ + `P "Calling \"$(b,infer) $(b,run) $(i,[options])\" is equivalent to performing the following \ + sequence of commands:"; + `Pre "$(b,infer) $(b,capture) $(i,[options])\n\ + $(b,infer) $(b,analyze) $(i,[options])"; + ] + ~see_also:CLOpt.[Analyze; Capture; Report] + +let command_to_data = + let mk cmd mk_doc = + let long = long_of_command cmd in + let command_doc = mk_doc (exe_name_of_command cmd) in + cmd, { long; command_doc } in + CLOpt.[mk Analyze analyze; mk Capture capture; mk Clang clang; mk Compile compile; + mk Report report; mk ReportDiff reportdiff; mk Run run] + +let data_of_command command = + List.Assoc.find_exn ~equal:CLOpt.equal_command command_to_data command diff --git a/infer/src/base/CommandDoc.mli b/infer/src/base/CommandDoc.mli new file mode 100644 index 000000000..0f9e8c0f5 --- /dev/null +++ b/infer/src/base/CommandDoc.mli @@ -0,0 +1,19 @@ +(* + * Copyright (c) 2017 - present Facebook, Inc. + * All rights reserved. + * + * This source code is licensed under the BSD style license found in the + * LICENSE file in the root directory of this source tree. An additional grant + * of patent rights can be found in the PATENTS file in the same directory. + *) +open! IStd + +module CLOpt = CommandLineOption + +type data = { long: string; command_doc: CLOpt.command_doc } + +val inferconfig_env_var : string +val inferconfig_file : string + +val infer : CLOpt.command_doc +val data_of_command : CLOpt.command -> data diff --git a/infer/src/base/CommandLineOption.ml b/infer/src/base/CommandLineOption.ml index 3af5763bf..d9b30b031 100644 --- a/infer/src/base/CommandLineOption.ml +++ b/infer/src/base/CommandLineOption.ml @@ -16,6 +16,8 @@ module YBU = Yojson.Basic.Util let (=) = String.equal +let manpage_s_notes = "NOTES" + let is_env_var_set v = Option.value (Option.map (Sys.getenv v) ~f:((=) "1")) ~default:false @@ -30,7 +32,9 @@ let init_work_dir, is_originator = Unix.putenv ~key:"INFER_CWD" ~data:real_cwd; (real_cwd, true) -let strict_mode = is_env_var_set "INFER_STRICT_MODE" +let strict_mode_env_var = "INFER_STRICT_MODE" + +let strict_mode = is_env_var_set strict_mode_env_var let warnf = if strict_mode then failwithf @@ -55,42 +59,33 @@ let to_arg_spec = function 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 -type section = - Analysis | BufferOverrun | Checkers | Clang | Crashcontext | Driver | Java | Print -[@@deriving compare] - -let equal_section = [%compare.equal : section ] -let all_sections = - [ Analysis; BufferOverrun; Checkers; Clang; Crashcontext; Driver; Java; Print ] - -(* NOTE: All variants must be also added to `all_parse_tags` below *) -type 'a parse = Differential | Infer of 'a | Javac | NoParse [@@deriving compare] +(* NOTE: All variants must be also added to `all_parse_modes` below *) +type parse_mode = InferCommand | Javac | NoParse [@@deriving compare] +let equal_parse_mode = [%compare.equal : parse_mode] -type parse_mode = section list parse [@@deriving compare] +let all_parse_modes = [InferCommand; Javac; NoParse] -type parse_action = section parse [@@deriving compare] +let accept_unknown_args = function + | Javac | NoParse -> true + | InferCommand -> false -let equal_parse_action = [%compare.equal : parse_action ] +(* NOTE: All variants must be also added to `all_commands` below *) +type command = + | Analyze | Capture | Clang | Compile | Report | ReportDiff | Run +[@@deriving compare] -(* NOTE: All variants must be also added to `all_parse_tags` below *) -type parse_tag = AllInferTags | OneTag of unit parse [@@deriving compare] +let equal_command = [%compare.equal : command] -let equal_parse_tag = [%compare.equal : parse_tag ] -let all_parse_tags = [ - AllInferTags; OneTag Differential; OneTag (Infer ()); OneTag Javac; OneTag NoParse +let all_commands = [ + Analyze; Capture; Clang; Compile; Report; ReportDiff; Run ] -let to_parse_tag parse = - match parse with - | Differential -> OneTag Differential - | Infer _ -> OneTag (Infer ()) - | Javac -> OneTag Javac - | NoParse -> OneTag NoParse - -let accept_unknown_args = function - | Infer Print | Javac | NoParse -> true - | Infer (Analysis | BufferOverrun | Checkers | Clang | Crashcontext | Driver | Java) - | Differential -> false +type command_doc = { + title : Cmdliner.Manpage.title; + manual_pre_options : Cmdliner.Manpage.block list; + manual_options : Cmdliner.Manpage.block list option; + manual_post_options : Cmdliner.Manpage.block list; +} type desc = { long: string; short: string; meta: string; doc: string; spec: spec; @@ -103,27 +98,7 @@ let dashdash long = | "" | "--" -> long | _ -> "--" ^ long -let short_meta {short; meta; spec} = - String.concat ~sep:" " - ((if short = "" then [] else ["| -" ^ short]) @ - (match spec with - | Symbol (symbols, _) -> - ["{ " ^ (String.concat ~sep:" | " symbols) ^ " }" ^ meta] - | _ -> - if meta = "" then [] else ["<" ^ meta ^ ">"])) - -let left_length long short_meta = - (String.length (dashdash long)) + (String.length short_meta) - -let max_left_length limit current ({long; spec} as desc) = - let short_meta = - match spec with - | Symbol _ -> short_meta {desc with spec = Unit (fun () -> ())} - | _ -> short_meta desc in - let length = left_length long short_meta in - if length > limit then current else max current length - -let xdesc {long; short; spec; doc} = +let xdesc {long; short; spec} = let key long short = match long, short with | "", "" -> "" @@ -145,86 +120,8 @@ let xdesc {long; short; spec; doc} = | _ -> spec in - (key long short, xspec long spec, doc) - -let wrap_line indent_string wrap_length line = - let indent_length = String.length indent_string in - let word_sep = ' ' in - let words = String.split ~on:word_sep line in - let word_sep_str = String.of_char word_sep in - let add_word_to_paragraph (rev_lines, non_empty, line, line_length) word = - let word_length = String.length word in - let new_length = line_length + (String.length word_sep_str) + word_length in - let new_non_empty = non_empty || word <> "" in - if new_length > wrap_length && non_empty then - (line::rev_lines, true, indent_string ^ word, indent_length + word_length) - else - let sep = if Int.equal line_length indent_length then "" else word_sep_str in - let new_line = line ^ sep ^ word in - if new_length > wrap_length && new_non_empty then - (new_line::rev_lines, false, indent_string, indent_length) - else - (rev_lines, new_non_empty, new_line, String.length new_line) in - let (rev_lines, _, line, _) = - List.fold ~f:add_word_to_paragraph ~init:([], false, "", 0) words in - List.rev (line::rev_lines) - -let pad_and_xform doc_width left_width desc = - match desc with - | {doc = ""} -> - xdesc desc - | {long; doc} -> - let indent_doc doc = - (* 2 blank columns before option + 2 columns of gap between flag and doc *) - let left_indent = 4 + left_width in - let newline_padding = "\n" ^ String.make left_indent ' ' in - (* align every line after the first one of [doc] *) - let doc = String.concat_map doc ~f:(function - | '\n' -> newline_padding - | c -> String.of_char c) in - (* align the first line of [doc] *) - let short_meta = short_meta desc in - let gap = left_width - (left_length long short_meta) in - if gap < 0 then - short_meta ^ "\n" ^ (String.make left_indent ' ') ^ doc - else - short_meta ^ (String.make (gap + 1) ' ') ^ doc - in - let wrapped_lines = - let lines = String.split ~on:'\n' doc in - let wrap_line s = - if String.length s > doc_width then - wrap_line "" doc_width s - else [s] in - List.map ~f:wrap_line lines in - let doc = indent_doc (String.concat ~sep:"\n" (List.concat wrapped_lines)) in - xdesc {desc with doc} - -let align desc_list = - let min_term_width = 80 in - let terminal_width = min_term_width in - (* 2 blank columns before option + 2 columns of gap between flag and doc *) - let extra_space = 4 in - let min_left_width = 15 in - let max_left_width = 49 in - let doc_width term_width left_width = term_width - extra_space - left_width in - let term_width doc_width left_width = left_width + extra_space + doc_width in - let max_doc_width = 100 in - let max_term_width = term_width max_left_width max_doc_width in - (* how many columns to reserve for the option names - NOTE: this doesn't take into account "--help | -h" nor "--help-full", but fortunately these - have short names *) - let left_width = - let opt_left_width = - List.fold ~f:(max_left_length max_left_width) ~init:0 desc_list in - let (--) a b = float_of_int a -. float_of_int b in - let multiplier = (max_left_width -- min_left_width) /. (max_term_width -- terminal_width) in - (* at 80 columns use min_left_width then use extra columns until opt_left_width *) - let cols_after_min_width = float_of_int (max 0 (terminal_width - min_term_width)) in - min (int_of_float (cols_after_min_width *. multiplier) + min_left_width) opt_left_width in - let doc_width = min max_doc_width (doc_width terminal_width left_width) in - (List.map ~f:(pad_and_xform doc_width left_width) desc_list, (doc_width, left_width)) - + (* Arg doesn't need to know anything about documentation since we generate our own *) + (key long short, xspec long spec, "") let check_no_duplicates desc_list = let rec check_for_duplicates_ = function @@ -238,35 +135,51 @@ let check_no_duplicates desc_list = check_for_duplicates_ (List.sort ~cmp:(fun (x, _, _) (y, _, _) -> String.compare x y) desc_list) -let parse_tag_desc_lists = List.map ~f:(fun parse_tag -> (parse_tag, ref [])) all_parse_tags +let parse_mode_desc_lists = List.map ~f:(fun parse_mode -> (parse_mode, ref [])) all_parse_modes + +module SectionMap = Caml.Map.Make (struct + type t = String.t + (* this must be the reverse of the order in which we want the sections to appear in the + manual *) + let compare s1 s2 = + if String.equal s1 s2 then + (* this simplifies the next two cases *) + 0 + else if String.equal s1 Cmdliner.Manpage.s_options then + (* ensure OPTIONS section is last (hence first in the manual) *) + 1 + else if String.equal s2 Cmdliner.Manpage.s_options then + (* same as above *) + -1 + else + (* reverse order *) + String.compare s2 s1 + end) -let infer_section_desc_lists = List.map ~f:(fun section -> (section, ref [])) all_sections +let help_sections_desc_lists = + List.map all_commands ~f:(fun command -> (command, ref SectionMap.empty)) +let hidden_descs_list = ref [] (** add [desc] to the one relevant parse_tag_desc_lists for the purposes of parsing, and, in the - case of Infer, include [desc] in --help only for the relevant sections. *) -let add parse_mode desc = - let add_to_tag tag = - let desc_list = List.Assoc.find_exn parse_tag_desc_lists tag in - desc_list := desc :: !desc_list in - (match parse_mode with - | Javac | NoParse -> () - | Differential | Infer _ -> add_to_tag AllInferTags - ); - add_to_tag (to_parse_tag parse_mode); - match parse_mode with - | Differential | Javac | NoParse -> () - | Infer sections -> - List.iter infer_section_desc_lists ~f:(fun (section, desc_list) -> - let desc = if List.mem ~equal:equal_section sections section then - desc - else - {desc with meta = ""; doc = ""} in - desc_list := desc :: !desc_list) + case of InferCommand, include [desc] in --help only for the relevant sections. *) +let add parse_mode sections desc = + let desc_list = List.Assoc.find_exn parse_mode_desc_lists parse_mode in + desc_list := desc :: !desc_list; + let add_to_section (command, section) = + let sections = List.Assoc.find_exn ~equal:equal_command help_sections_desc_lists command in + let prev_contents = + try SectionMap.find section !sections + with Not_found -> [] in + sections := SectionMap.add section (desc::prev_contents) !sections in + List.iter sections ~f:add_to_section; + if List.is_empty sections then + hidden_descs_list := desc :: !hidden_descs_list; + () let deprecate_desc parse_mode ~long ~short ~deprecated desc = let warn () = match parse_mode with | Javac | NoParse -> () - | Differential | Infer _ -> + | InferCommand -> 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 @@ -281,7 +194,7 @@ let deprecate_desc parse_mode ~long ~short ~deprecated desc = { long = ""; short = deprecated; meta = ""; doc = ""; spec = deprecated_spec; decode_json = deprecated_decode_json } -let mk ?(deprecated=[]) ?(parse_mode=Infer []) +let mk ?(deprecated=[]) ?(parse_mode=InferCommand) ?(in_help=[]) ~long ?short:short0 ~default ~meta doc ~default_to_string ~decode_json ~mk_setter ~mk_spec = let variable = ref default in let closure = mk_setter variable in @@ -294,21 +207,20 @@ let mk ?(deprecated=[]) ?(parse_mode=Infer []) let doc = let default_string = default_to_string default in if default_string = "" then doc - else doc ^ " (default: " ^ default_string ^ ")" in + else + let doc_default_sep = if String.is_suffix ~suffix:"\n" doc then "" else " " in + doc ^ doc_default_sep ^ "(default: $(i," ^ Cmdliner.Manpage.escape default_string ^ "))" in let short = match short0 with Some c -> String.of_char c | None -> "" in let desc = {long; short=short; meta; doc; spec; decode_json} in (* add desc for long option, with documentation (which includes any short option) for exes *) - if long <> "" then add parse_mode desc ; + if long <> "" then add parse_mode in_help desc ; (* add desc for short option only for parsing, without documentation *) - let parse_mode_no_sections = match parse_mode with - | Infer _ -> Infer [] - | Differential | Javac | NoParse -> parse_mode in if short <> "" then - add parse_mode_no_sections {desc with long = ""; meta = ""; doc = ""} ; + add parse_mode [] {desc with long = ""; meta = ""; doc = ""} ; (* add desc for deprecated options only for parsing, without documentation *) List.iter deprecated ~f:(fun deprecated -> deprecate_desc parse_mode ~long ~short:short ~deprecated desc - |> add parse_mode_no_sections) ; + |> add parse_mode []) ; variable (* begin parsing state *) @@ -322,20 +234,21 @@ let arg_being_parsed : int ref = ref 0 (* list of arg specifications currently being used by Arg.parse_argv_dynamic *) let curr_speclist : (Arg.key * Arg.spec * Arg.doc) list ref = ref [] -let unknown_args_action = ref `Reject +let unknown_args_action = ref `ParseCommands +let subcommands = ref [] let subcommand_actions = ref [] let rev_anon_args = ref [] -(* keep track of the final parse action to drive the remainder of the program *) -let final_parse_action = ref (Infer Driver) +(* keep track of the current active command to drive the remainder of the program *) +let curr_command = ref None (* end parsing state *) type 'a t = ?deprecated:string list -> long:Arg.key -> ?short:char -> - ?parse_mode:parse_mode -> ?meta:string -> Arg.doc -> + ?parse_mode:parse_mode -> ?in_help:(command * string) list -> ?meta:string -> Arg.doc -> 'a let string_json_decoder ~long ~inferconfig_dir:_ json = @@ -351,25 +264,25 @@ let path_json_decoder ~long ~inferconfig_dir json = let list_json_decoder json_decoder ~inferconfig_dir json = List.concat (YBU.convert_each (json_decoder ~inferconfig_dir) json) -let mk_set var value ?(deprecated=[]) ~long ?short ?parse_mode ?(meta="") doc = +let mk_set var value ?(deprecated=[]) ~long ?short ?parse_mode ?in_help ?(meta="") doc = let setter () = var := value in ignore( - mk ~deprecated ~long ?short ~default:() ?parse_mode ~meta doc + mk ~deprecated ~long ?short ~default:() ?parse_mode ?in_help ~meta doc ~default_to_string:(fun () -> "") ~decode_json:(string_json_decoder ~long) ~mk_setter:(fun _ _ -> setter ()) ~mk_spec:(fun _ -> Unit setter) ) let mk_option ?(default=None) ?(default_to_string=fun _ -> "") ~f - ?(deprecated=[]) ~long ?short ?parse_mode ?(meta="") doc = - mk ~deprecated ~long ?short ~default ?parse_mode ~meta doc + ?(deprecated=[]) ~long ?short ?parse_mode ?in_help ?(meta="string") doc = + mk ~deprecated ~long ?short ~default ?parse_mode ?in_help ~meta doc ~default_to_string ~decode_json:(string_json_decoder ~long) ~mk_setter:(fun var str -> var := f str) ~mk_spec:(fun set -> String set) let mk_bool ?(deprecated_no=[]) ?(default=false) ?(f=fun b -> b) - ?(deprecated=[]) ~long ?short ?parse_mode ?(meta="") doc = + ?(deprecated=[]) ~long ?short ?parse_mode ?in_help ?(meta="") doc = let nolong = let len = String.length long in if len > 3 && String.sub long ~pos:0 ~len:3 = "no-" then @@ -384,8 +297,8 @@ let mk_bool ?(deprecated_no=[]) ?(default=false) ?(f=fun b -> b) in let doc long short = match short with - | Some short -> doc ^ " (Conversely: --" ^ long ^ " | -" ^ String.of_char short ^ ")" - | None -> doc ^ " (Conversely: --" ^ long ^ ")" + | Some short -> doc ^ " (Conversely: $(b,--" ^ long ^ ") | $(b,-" ^ String.of_char short ^ "))" + | None -> doc ^ " (Conversely: $(b,--" ^ long ^ "))" in let doc, nodoc = if not default then @@ -395,13 +308,14 @@ let mk_bool ?(deprecated_no=[]) ?(default=false) ?(f=fun b -> b) let default_to_string _ = "" in let mk_spec set = Unit (fun () -> set "") in let var = - mk ~long ?short ~deprecated ~default ?parse_mode + mk ~long ?short ~deprecated ~default ?parse_mode ?in_help ~meta doc ~default_to_string ~mk_setter:(fun var _ -> var := f true) ~decode_json:(fun ~inferconfig_dir:_ json -> [dashdash (if YBU.to_bool json then long else nolong)]) ~mk_spec in ignore( - mk ~long:nolong ?short:noshort ~deprecated:deprecated_no ~default:(not default) ?parse_mode + mk ~long:nolong ?short:noshort ~deprecated:deprecated_no ~default:(not default) + ?parse_mode ?in_help ~meta nodoc ~default_to_string ~mk_setter:(fun _ _ -> var := f false) ~decode_json:(fun ~inferconfig_dir:_ json -> [dashdash (if YBU.to_bool json then nolong else long)]) @@ -409,61 +323,62 @@ let mk_bool ?(deprecated_no=[]) ?(default=false) ?(f=fun b -> b) var let mk_bool_group ?(deprecated_no=[]) ?(default=false) - ?(deprecated=[]) ~long ?short ?parse_mode ?(meta="") doc children no_children = + ?(deprecated=[]) ~long ?short ?parse_mode ?in_help ?meta doc children no_children = let f b = List.iter ~f:(fun child -> child := b) children ; List.iter ~f:(fun child -> child := not b) no_children ; b in - mk_bool ~deprecated ~deprecated_no ~default ~long ?short ~f ?parse_mode ~meta doc + mk_bool ~deprecated ~deprecated_no ~default ~long ?short ~f ?parse_mode ?in_help ?meta doc -let mk_int ~default ?(deprecated=[]) ~long ?short ?parse_mode ?(meta="") doc = - mk ~deprecated ~long ?short ~default ?parse_mode ~meta doc +let mk_int ~default ?(deprecated=[]) ~long ?short ?parse_mode ?in_help ?(meta="int") doc = + mk ~deprecated ~long ?short ~default ?parse_mode ?in_help ~meta doc ~default_to_string:string_of_int ~mk_setter:(fun var str -> var := (int_of_string str)) ~decode_json:(string_json_decoder ~long) ~mk_spec:(fun set -> String set) -let mk_int_opt ?default ?(deprecated=[]) ~long ?short ?parse_mode ?(meta="") doc = +let mk_int_opt ?default ?(deprecated=[]) ~long ?short ?parse_mode ?in_help ?(meta="int") doc = let default_to_string = function Some f -> string_of_int f | None -> "" in let f s = Some (int_of_string s) in - mk_option ~deprecated ~long ?short ~default ~default_to_string ~f ?parse_mode ~meta doc + mk_option ~deprecated ~long ?short ~default ~default_to_string ~f ?parse_mode ?in_help ~meta doc -let mk_float ~default ?(deprecated=[]) ~long ?short ?parse_mode ?(meta="") doc = - mk ~deprecated ~long ?short ~default ?parse_mode ~meta doc +let mk_float ~default ?(deprecated=[]) ~long ?short ?parse_mode ?in_help ?(meta="float") doc = + mk ~deprecated ~long ?short ~default ?parse_mode ?in_help ~meta doc ~default_to_string:string_of_float ~mk_setter:(fun var str -> var := (float_of_string str)) ~decode_json:(string_json_decoder ~long) ~mk_spec:(fun set -> String set) -let mk_float_opt ?default ?(deprecated=[]) ~long ?short ?parse_mode ?(meta="") doc = +let mk_float_opt ?default ?(deprecated=[]) ~long ?short ?parse_mode ?in_help ?(meta="float") doc = let default_to_string = function Some f -> string_of_float f | None -> "" in let f s = Some (float_of_string s) in - mk_option ~deprecated ~long ?short ~default ~default_to_string ~f ?parse_mode ~meta doc + mk_option ~deprecated ~long ?short ~default ~default_to_string ~f ?parse_mode ?in_help ~meta doc -let mk_string ~default ?(f=fun s -> s) ?(deprecated=[]) ~long ?short ?parse_mode ?(meta="") doc = - mk ~deprecated ~long ?short ~default ?parse_mode ~meta doc +let mk_string ~default ?(f=fun s -> s) ?(deprecated=[]) ~long ?short ?parse_mode ?in_help + ?(meta="string") doc = + mk ~deprecated ~long ?short ~default ?parse_mode ?in_help ~meta doc ~default_to_string:(fun s -> s) ~mk_setter:(fun var str -> var := f str) ~decode_json:(string_json_decoder ~long) ~mk_spec:(fun set -> String set) -let mk_string_opt ?default ?(f=fun s -> s) ?(deprecated=[]) ~long ?short ?parse_mode - ?(meta="") doc = +let mk_string_opt ?default ?(f=fun s -> s) ?(deprecated=[]) ~long ?short ?parse_mode ?in_help + ?(meta="string") doc = let default_to_string = function Some s -> s | None -> "" in let f s = Some (f s) in - mk_option ~deprecated ~long ?short ~default ~default_to_string ~f ?parse_mode ~meta doc + mk_option ~deprecated ~long ?short ~default ~default_to_string ~f ?parse_mode ?in_help ~meta doc let mk_string_list ?(default=[]) ?(f=fun s -> s) - ?(deprecated=[]) ~long ?short ?parse_mode ?(meta="") doc = - mk ~deprecated ~long ?short ~default ?parse_mode ~meta doc + ?(deprecated=[]) ~long ?short ?parse_mode ?in_help ?(meta="+string") doc = + mk ~deprecated ~long ?short ~default ?parse_mode ?in_help ~meta doc ~default_to_string:(String.concat ~sep:", ") ~mk_setter:(fun var str -> var := (f str) :: !var) ~decode_json:(list_json_decoder (string_json_decoder ~long)) ~mk_spec:(fun set -> String set) let mk_path_helper ~setter ~default_to_string - ~default ~deprecated ~long ~short ~parse_mode ~meta ~decode_json doc = + ~default ~deprecated ~long ~short ~parse_mode ~in_help ~meta ~decode_json doc = let normalize_path_in_args_being_parsed str = if Filename.is_relative str then ( (* Replace relative paths with absolute ones on the fly in the args being parsed. This assumes @@ -476,60 +391,68 @@ let mk_path_helper ~setter ~default_to_string abs_path ) else str in - mk ~deprecated ~long ?short ~default ?parse_mode ~meta doc + mk ~deprecated ~long ?short ~default ?parse_mode ?in_help ~meta doc ~decode_json ~default_to_string ~mk_setter:(fun var str -> let abs_path = normalize_path_in_args_being_parsed str in setter var abs_path) ~mk_spec:(fun set -> String set) -let mk_path ~default ?(deprecated=[]) ~long ?short ?parse_mode ?(meta="path") = +let mk_path ~default ?(deprecated=[]) ~long ?short ?parse_mode ?in_help ?(meta="path") = mk_path_helper ~setter:(fun var x -> var := x) ~decode_json:(path_json_decoder ~long) ~default_to_string:(fun s -> s) - ~default ~deprecated ~long ~short ~parse_mode ~meta + ~default ~deprecated ~long ~short ~parse_mode ~in_help ~meta -let mk_path_opt ?default ?(deprecated=[]) ~long ?short ?parse_mode ?(meta="path") = +let mk_path_opt ?default ?(deprecated=[]) ~long ?short ?parse_mode ?in_help ?(meta="path") = mk_path_helper ~setter:(fun var x -> var := Some x) ~decode_json:(path_json_decoder ~long) ~default_to_string:(function Some s -> s | None -> "") - ~default ~deprecated ~long ~short ~parse_mode ~meta + ~default ~deprecated ~long ~short ~parse_mode ~in_help ~meta -let mk_path_list ?(default=[]) ?(deprecated=[]) ~long ?short ?parse_mode ?(meta="path") = +let mk_path_list ?(default=[]) ?(deprecated=[]) ~long ?short ?parse_mode ?in_help ?(meta="+path") = mk_path_helper ~setter:(fun var x -> var := x :: !var) ~decode_json:(list_json_decoder (path_json_decoder ~long)) ~default_to_string:(String.concat ~sep:", ") - ~default ~deprecated ~long ~short ~parse_mode ~meta + ~default ~deprecated ~long ~short ~parse_mode ~in_help ~meta -let mk_symbol ~default ~symbols ~eq ?(deprecated=[]) ~long ?short ?parse_mode ?(meta="") doc = +let mk_symbols_meta symbols = + let strings = List.map ~f:fst symbols in + Printf.sprintf "{ %s }" (String.concat ~sep:" | " strings) + +let mk_symbol ~default ~symbols ~eq ?(deprecated=[]) ~long ?short ?parse_mode ?in_help ?meta doc = let strings = List.map ~f:fst symbols in let sym_to_str = List.map ~f:(fun (x,y) -> (y,x)) symbols in let of_string str = List.Assoc.find_exn ~equal:String.equal symbols str in let to_string sym = List.Assoc.find_exn ~equal:eq sym_to_str sym in - mk ~deprecated ~long ?short ~default ?parse_mode ~meta doc + let meta = Option.value meta ~default:(mk_symbols_meta symbols) in + mk ~deprecated ~long ?short ~default ?parse_mode ?in_help ~meta doc ~default_to_string:(fun s -> to_string s) ~mk_setter:(fun var str -> var := of_string str) ~decode_json:(string_json_decoder ~long) ~mk_spec:(fun set -> Symbol (strings, set)) -let mk_symbol_opt ~symbols ?(deprecated=[]) ~long ?short ?parse_mode ?(meta="") doc = +let mk_symbol_opt ~symbols ?(deprecated=[]) ~long ?short ?parse_mode ?in_help ?meta doc = let strings = List.map ~f:fst symbols in let of_string str = List.Assoc.find_exn ~equal:String.equal symbols str in - mk ~deprecated ~long ?short ~default:None ?parse_mode ~meta doc + let meta = Option.value meta ~default:(mk_symbols_meta symbols) in + mk ~deprecated ~long ?short ~default:None ?parse_mode ?in_help ~meta doc ~default_to_string:(fun _ -> "") ~mk_setter:(fun var str -> var := Some (of_string str)) ~decode_json:(string_json_decoder ~long) ~mk_spec:(fun set -> Symbol (strings, set)) -let mk_symbol_seq ?(default=[]) ~symbols ~eq ?(deprecated=[]) ~long ?short ?parse_mode - ?(meta="") doc = +let mk_symbol_seq ?(default=[]) ~symbols ~eq ?(deprecated=[]) ~long ?short ?parse_mode ?in_help + ?meta doc = let sym_to_str = List.map ~f:(fun (x,y) -> (y,x)) symbols in let of_string str = List.Assoc.find_exn ~equal:String.equal symbols str in let to_string sym = List.Assoc.find_exn ~equal:eq sym_to_str sym in - mk ~deprecated ~long ?short ~default ?parse_mode ~meta:(",-separated sequence" ^ meta) doc + let meta = Option.value meta ~default:(",-separated sequence of " ^ mk_symbols_meta symbols) in + mk ~deprecated ~long ?short ~default ?parse_mode ?in_help + ~meta doc ~default_to_string:(fun syms -> String.concat ~sep:" " (List.map ~f:to_string syms)) ~mk_setter:(fun var str_seq -> var := List.map ~f:of_string (String.split ~on:',' str_seq)) @@ -539,15 +462,15 @@ let mk_symbol_seq ?(default=[]) ~symbols ~eq ?(deprecated=[]) ~long ?short ?pars ~mk_spec:(fun set -> String set) let mk_set_from_json ~default ~default_to_string ~f - ?(deprecated=[]) ~long ?short ?parse_mode ?(meta="json") doc = - mk ~deprecated ~long ?short ?parse_mode ~meta doc + ?(deprecated=[]) ~long ?short ?parse_mode ?in_help ?(meta="json") doc = + mk ~deprecated ~long ?short ?parse_mode ?in_help ~meta doc ~default ~default_to_string ~mk_setter:(fun var json -> var := f (Yojson.Basic.from_string json)) ~decode_json:(fun ~inferconfig_dir:_ json -> [dashdash long; Yojson.Basic.to_string json]) ~mk_spec:(fun set -> String set) -let mk_json ?(deprecated=[]) ~long ?short ?parse_mode ?(meta="json") doc = - mk ~deprecated ~long ?short ?parse_mode ~meta doc +let mk_json ?(deprecated=[]) ~long ?short ?parse_mode ?in_help ?(meta="json") doc = + mk ~deprecated ~long ?short ?parse_mode ?in_help ~meta doc ~default:(`List []) ~default_to_string:Yojson.Basic.to_string ~mk_setter:(fun var json -> var := Yojson.Basic.from_string json) ~decode_json:(fun ~inferconfig_dir:_ json -> [dashdash long; Yojson.Basic.to_string json]) @@ -557,164 +480,143 @@ let mk_json ?(deprecated=[]) ~long ?short ?parse_mode ?(meta="json") doc = [parse_action_accept_unknown_args] is true. *) let mk_anon () = rev_anon_args -let mk_rest ?(parse_mode=Infer []) doc = +let mk_rest ?(parse_mode=InferCommand) ?(in_help=[]) doc = let rest = ref [] in let spec = Rest (fun arg -> rest := arg :: !rest) in - add parse_mode {long = "--"; short = ""; meta = ""; doc; spec; - decode_json = fun ~inferconfig_dir:_ _ -> []} ; + add parse_mode in_help {long = "--"; short = ""; meta = ""; doc; spec; + decode_json = fun ~inferconfig_dir:_ _ -> []} ; rest -let set_curr_speclist_for_parse_action ~usage ?(parse_all=false) parse_action = - let full_speclist = ref [] in - +let normalize_desc_list speclist = + let norm k = + let remove_no s = + let len = String.length k in + if len > 3 && String.sub s ~pos:0 ~len:3 = "no-" + then String.sub s ~pos:3 ~len:(len - 3) + else s in + let remove_weird_chars = + String.filter ~f:(function + | 'a'..'z' | '0'..'9' | '-' -> true + | _ -> false) in + remove_weird_chars @@ String.lowercase @@ remove_no k in + let compare_specs {long = x} {long = y} = + match x, y with + | "--", "--" -> 0 + | "--", _ -> 1 + | _, "--" -> -1 + | _ -> + let lower_norm s = String.lowercase @@ norm s in + String.compare (lower_norm x) (lower_norm y) in + let sort speclist = List.sort ~cmp:compare_specs speclist in + sort speclist + +let mk_command_doc ~title ~section ~version ~date ~short_description ~synopsis ~description + ?options ?exit_status ?environment ?files ?notes ?bugs ?examples ~see_also + command_str = + let add_if section blocks = match blocks with + | None -> `Blocks [] + | Some bs -> `Blocks (`S section :: bs) in + let manual_pre_options = [ + `S Cmdliner.Manpage.s_name; + (* the format of the following line is mandated by man(7) *) + `Pre (Printf.sprintf "%s - %s" command_str short_description); + `S Cmdliner.Manpage.s_synopsis; + `Blocks synopsis; + `S Cmdliner.Manpage.s_description; + `Blocks description; + ] in + let manual_post_options = [ + add_if Cmdliner.Manpage.s_exit_status exit_status; + add_if Cmdliner.Manpage.s_environment environment; + add_if Cmdliner.Manpage.s_files files; + add_if manpage_s_notes notes; + add_if Cmdliner.Manpage.s_bugs bugs; + add_if Cmdliner.Manpage.s_examples examples; + `S Cmdliner.Manpage.s_see_also; + `Blocks see_also; + ] in + let command_doc = { + title = command_str, section, date, version, title; + manual_pre_options; manual_options = options; manual_post_options; + } in + command_doc + +let set_curr_speclist_for_parse_mode ~usage parse_mode = let curr_usage status = prerr_endline (String.concat_array ~sep:" " !args_to_parse) ; - Arg.usage !curr_speclist usage ; - exit status - and full_usage status = - Arg.usage (to_arg_speclist !full_speclist) usage ; + prerr_endline usage ; exit status in (* "-help" and "--help" are automatically recognized by Arg.parse, so we have to give them special treatment *) - let add_or_suppress_help (speclist, (doc_width,left_width)) = + let add_or_suppress_help speclist = let unknown opt = (opt, Unit (fun () -> raise (Arg.Bad ("unknown option '" ^ opt ^ "'"))), "") in - let mk_spec ~long ?(short="") spec doc = - pad_and_xform doc_width left_width { - long; short; meta=""; spec; doc; - decode_json=fun ~inferconfig_dir:_ _ -> raise (Arg.Bad long); - } in - speclist @ [ - mk_spec ~long:"help" ~short:"h" - (Unit (fun () -> curr_usage 0)) - "Display this list of options"; - mk_spec ~long:"help-full" - (Unit (fun () -> full_usage 0)) - "Display the full list of options, including internal and experimental options"; - (unknown "-help") - ] - in - let normalize speclist = - let norm k = - let remove_no s = - let len = String.length k in - if len > 3 && String.sub s ~pos:0 ~len:3 = "no-" - then String.sub s ~pos:3 ~len:(len - 3) - else s in - let remove_weird_chars = - String.filter ~f:(function - | 'a'..'z' | '0'..'9' | '-' -> true - | _ -> false) in - remove_weird_chars @@ String.lowercase @@ remove_no k in - let compare_specs {long = x} {long = y} = - match x, y with - | "--", "--" -> 0 - | "--", _ -> 1 - | _, "--" -> -1 - | _ -> - let lower_norm s = String.lowercase @@ norm s in - String.compare (lower_norm x) (lower_norm y) in - let sort speclist = List.sort ~cmp:compare_specs speclist in - align (sort speclist) - in - let add_to_curr_speclist ?(add_help=false) ?header parse_action = - let mk_header_spec heading = - ("", Unit (fun () -> ()), "\n## " ^ heading ^ "\n") in - let exe_descs = match parse_all, parse_action with - | true, _ -> - List.Assoc.find_exn ~equal:equal_parse_tag parse_tag_desc_lists AllInferTags - | false, Infer section -> - List.Assoc.find_exn ~equal:equal_section infer_section_desc_lists section - | false, (Differential | Javac | NoParse) -> - to_parse_tag parse_action - |> List.Assoc.find_exn ~equal:equal_parse_tag parse_tag_desc_lists in - let (exe_speclist, widths) = normalize !exe_descs in - let exe_speclist = if add_help - then add_or_suppress_help (exe_speclist, widths) - else exe_speclist in - let exe_speclist = to_arg_speclist exe_speclist in - (* Return false if the same option appears in [speclist], unless [doc] is non-empty and the - documentation in [speclist] is empty. The goal is to keep only one instance of each option, - and that instance is the one that has a non-empty docstring if there is one. *) - let is_not_dup_with_doc speclist (opt, _, doc) = - opt = "" || - List.for_all ~f:(fun (opt', _, doc') -> - (doc <> "" && doc' = "") || (not (String.equal opt opt'))) speclist in - let unique_exe_speclist = List.filter ~f:(is_not_dup_with_doc !curr_speclist) exe_speclist in - curr_speclist := List.filter ~f:(is_not_dup_with_doc unique_exe_speclist) !curr_speclist @ - (match header with - | Some s -> (to_arg_spec_triple (mk_header_spec s)):: unique_exe_speclist - | None -> unique_exe_speclist) + let has_opt opt = List.exists ~f:(fun (o, _, _) -> String.equal opt o) speclist in + let add_unknown opt = if not (has_opt opt) then List.cons (unknown opt) else Fn.id in + add_unknown "-help" @@ add_unknown "--help" @@ speclist in - (* speclist includes args for current exe with docs, and all other args without docs, so - that all args can be parsed, but --help and parse failures only show external args for - current exe *) - (* reset the speclist between calls to this function *) - curr_speclist := []; - if equal_parse_action parse_action (Infer Driver) then ( - add_to_curr_speclist ~add_help:true ~header:"Driver options" (Infer Driver); - add_to_curr_speclist ~header:"Checkers options" (Infer Checkers); - add_to_curr_speclist ~header:"Clang-specific options" (Infer Clang); - add_to_curr_speclist ~header:"Java-specific options" (Infer Java); - ) else - add_to_curr_speclist ~add_help:true parse_action - ; - assert( check_no_duplicates !curr_speclist ) - ; let full_desc_list = - let parse_tag = if parse_all then AllInferTags else to_parse_tag parse_action in - 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) - ; + List.Assoc.find_exn ~equal:equal_parse_mode parse_mode_desc_lists parse_mode in + curr_speclist := normalize_desc_list !full_desc_list + |> List.map ~f:xdesc + |> add_or_suppress_help + |> to_arg_speclist; + assert( check_no_duplicates !curr_speclist ); curr_usage -let select_parse_action ~usage ?parse_all action = - let usage = set_curr_speclist_for_parse_action ~usage ?parse_all action in - unknown_args_action := if accept_unknown_args action then `Add else `Reject; - final_parse_action := action; +let select_parse_mode ~usage action = + let usage = set_curr_speclist_for_parse_mode ~usage action in + unknown_args_action := if accept_unknown_args action then `Add else `ParseCommands; usage +let string_of_command command = + let (_, s, _) = List.Assoc.find_exn !subcommands ~equal:equal_command command in + s + let anon_fun arg = - match List.Assoc.find !subcommand_actions ~equal:String.equal arg with - | Some switch -> - switch () - | None -> - match !unknown_args_action with - | `Skip -> - () - | `Add -> - rev_anon_args := arg::!rev_anon_args - | `Reject -> + match !unknown_args_action with + | `ParseCommands -> ( + match !curr_command, List.Assoc.find !subcommand_actions ~equal:String.equal arg with + | None, Some switch -> switch () + | Some command, Some _ -> + raise (Arg.Bad + ("More than one subcommand specified: " ^ string_of_command command ^ ", " ^ + arg)) + | _, None -> raise (Arg.Bad ("unexpected anonymous argument: " ^ arg)) + ) + | `Skip -> + () + | `Add -> + rev_anon_args := arg::!rev_anon_args - -let mk_rest_actions ?(parse_mode=Infer []) doc ~usage decode_action = +let mk_rest_actions ?(parse_mode=InferCommand) ?(in_help=[]) 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 ~usage (decode_action arg) |> ignore; + select_parse_mode ~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 ~inferconfig_dir:_ _ -> []} ; + add parse_mode in_help {long = "--"; short = ""; meta = ""; doc; spec; + decode_json = fun ~inferconfig_dir:_ _ -> []} ; rest -let mk_switch_parse_action - parse_action ~usage ?(deprecated=[]) ~long ?(name=long) ?parse_mode ?(meta="") doc = +let mk_subcommand command ?(accept_unknown_args=false) ?deprecated ~long ?(name=long) + ?parse_mode ?in_help command_doc = let switch () = - select_parse_action ~usage parse_action |> ignore in + curr_command := Some command; + unknown_args_action := if accept_unknown_args then `Add else `ParseCommands in ignore( - mk ~deprecated ~long ~default:() ?parse_mode ~meta doc + mk ?deprecated ~long ~default:() ?parse_mode ?in_help ~meta:"" + (Printf.sprintf "activates the %s subcommand (see $(i,`infer %s --help`))" long long) ~default_to_string:(fun () -> "") ~decode_json:(string_json_decoder ~long) ~mk_setter:(fun _ _ -> switch ()) ~mk_spec:(fun _ -> Unit switch)); - let add_action opt = - let sub = (opt, switch) in - subcommand_actions := sub::!subcommand_actions in - add_action name + subcommands := (command, (command_doc, name, in_help))::!subcommands; + subcommand_actions := (name, switch)::!subcommand_actions let decode_inferconfig_to_argv path = let json = match Utils.read_json_file path with @@ -723,7 +625,7 @@ let decode_inferconfig_to_argv path = | 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 AllInferTags in + let desc_list = List.Assoc.find_exn ~equal:equal_parse_mode parse_mode_desc_lists InferCommand in let json_config = YBU.to_assoc json in let inferconfig_dir = Filename.dirname path in let one_config_item result (key, json_val) = @@ -779,7 +681,9 @@ let extra_env_args = ref [] let extend_env_args args = extra_env_args := List.rev_append args !extra_env_args -let parse_args ~usage ?parse_all action args0 = +(* TODO(t18057447) [should_expand_args] is a bogus hack to side-step a bug with expansion of + @argfiles *) +let parse_args ~usage initial_action ?(should_expand_args=true) ?initial_command args0 = (* look inside argfiles so we can move select arguments into the top line CLI and parse them into Config vars. note that we don't actually delete the arguments to the file, we just duplicate them on the CLI. javac is ok with this. *) @@ -811,15 +715,19 @@ let parse_args ~usage ?parse_all action args0 = acc else arg :: acc in + let args = if should_expand_args then + List.fold ~f:expand_argfiles ~init:[] (List.rev args0) + else + args0 in - let args = - if Option.is_none parse_all - then List.fold ~f:expand_argfiles ~init:[] (List.rev args0) - else args0 in let exe_name = Sys.executable_name in args_to_parse := Array.of_list (exe_name :: args); arg_being_parsed := 0; - let curr_usage = select_parse_action ~usage ?parse_all action in + let curr_usage = select_parse_mode ~usage initial_action in + Option.iter initial_command ~f:(fun command -> + let switch = List.Assoc.find_exn !subcommand_actions ~equal:String.equal + (string_of_command command) in + switch ()); (* 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 rec parse_loop () = @@ -828,19 +736,22 @@ let parse_args ~usage ?parse_all action args0 = anon_fun usage with | Arg.Bad usage_msg -> - if !unknown_args_action <> `Reject && is_unknown usage_msg then ( + if !unknown_args_action <> `ParseCommands && is_unknown usage_msg then ( anon_fun !args_to_parse.(!arg_being_parsed); parse_loop () ) else ( Pervasives.prerr_string usage_msg; exit 2 ) - | Arg.Help usage_msg -> Pervasives.print_string usage_msg; exit 0 + | Arg.Help _ -> + (* we handle --help by ourselves and error on -help, so Arg has no way to raise Help + anymore *) + assert false in parse_loop (); curr_usage -let parse ?config_file ~usage action = +let parse ?config_file ~usage action initial_command = 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 @@ -859,15 +770,100 @@ let parse ?config_file ~usage action = 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 ~usage ~parse_all:true (Infer Driver) inferconfig_args |> ignore; + (* TODO(t18057447) [should_expand_args] is a bogus hack to side-step a bug with expansion of + @argfiles *) + parse_args ~usage ~should_expand_args:false InferCommand inferconfig_args |> ignore; (* NOTE: do not add the contents of .inferconfig to INFER_ARGS. This helps avoid hitting the command line size limit. *) - parse_args ~usage ~parse_all:true (Infer Driver) env_args |> ignore; + (* TODO(t18057447) [should_expand_args] is a bogus hack to side-step a bug with expansion of + @argfiles *) + parse_args ~usage ~should_expand_args:false InferCommand env_args |> ignore; 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 ~usage action cl_args in + let curr_usage = parse_args ~usage action ?initial_command cl_args in add_parsed_args_to_args_to_export (); curr_usage in Unix.putenv ~key:args_env_var ~data:!args_to_export; - !final_parse_action, curr_usage + !curr_command, curr_usage + +let wrap_line indent_string wrap_length line0 = + let line = indent_string ^ line0 in + let indent_length = String.length indent_string in + let word_sep = ' ' in + let words = String.split ~on:word_sep line in + let word_sep_str = String.of_char word_sep in + let add_word_to_paragraph (rev_lines, non_empty, line, line_length) word = + let word_length = + let len = String.length word in + if String.is_prefix ~prefix:"$(b," word || String.is_prefix ~prefix:"$(i," word then + len - 4 (* length of formatting tag prefix *) + - 1 (* APPROXIMATION: closing parenthesis that will come after the word, or maybe later *) + else + len in + let new_length = line_length + (String.length word_sep_str) + word_length in + let new_non_empty = non_empty || word <> "" in + if new_length > wrap_length && non_empty then + (line::rev_lines, true, indent_string ^ word, indent_length + word_length) + else + let sep = if Int.equal line_length indent_length then "" else word_sep_str in + let new_line = line ^ sep ^ word in + if new_length > wrap_length && new_non_empty then + (new_line::rev_lines, false, indent_string, indent_length) + else + (rev_lines, new_non_empty, new_line, new_length) in + let (rev_lines, _, line, _) = + List.fold ~f:add_word_to_paragraph ~init:([], false, "", 0) words in + List.rev (line::rev_lines) + +let show_manual ?internal_section default_doc command_opt = + let command_doc = match command_opt with + | None -> + default_doc + | Some command -> + let (command_doc, _, _) = List.Assoc.find_exn !subcommands command in + command_doc in + let pp_meta f meta = match meta with + | "" -> () + | meta -> F.fprintf f " $(i,%s)" (Cmdliner.Manpage.escape meta) in + let pp_short f = function + | "" -> () + | s -> Format.fprintf f ",$(b,-%s)" s in + let block_of_desc { long; meta; short; doc } = + if String.equal doc "" then + [] + else + let doc_first_line, doc_other_lines = match String.split ~on:'\n' doc with + | first::other -> first, other + | [] -> "", [] in + (* Cmdline.Manpage does not format multi-paragraph documentation strings correctly for `I + blocks, so we do a bit of formatting by hand *) + let indent_string = " " in + let width = 77 (* Cmdliner.Manpage width limit it seems *) + - 7 (* base indentation of documentation strings *) in + `I (Format.asprintf "$(b,%s)%a%a" (dashdash long) pp_short short pp_meta meta, + doc_first_line) + :: List.concat_map (List.concat_map ~f:(wrap_line indent_string width) doc_other_lines) + ~f:(fun s -> [`Noblank; `Pre s]) in + let option_blocks = match command_doc.manual_options, command_opt with + | None, None -> + failwithf "Cannot create %s section" Cmdliner.Manpage.s_options + | Some blocks, _ -> + `S Cmdliner.Manpage.s_options :: blocks + | None, Some command -> + let sections = List.Assoc.find_exn help_sections_desc_lists command in + let hidden = + match internal_section with + | Some section -> + `S section :: `P "Use at your own risk." + :: List.concat_map ~f:block_of_desc (normalize_desc_list !hidden_descs_list) + | None -> + [] in + SectionMap.fold (fun section descs result -> + `S section :: + List.concat_map ~f:block_of_desc (normalize_desc_list descs) @ result) + !sections hidden in + let blocks = [`Blocks command_doc.manual_pre_options; `Blocks option_blocks; + `Blocks command_doc.manual_post_options] in + Cmdliner.Manpage.print `Auto Format.std_formatter (command_doc.title, blocks); + () diff --git a/infer/src/base/CommandLineOption.mli b/infer/src/base/CommandLineOption.mli index bd8ebf05e..60989a5a5 100644 --- a/infer/src/base/CommandLineOption.mli +++ b/infer/src/base/CommandLineOption.mli @@ -14,18 +14,30 @@ open! IStd (** Print to stderr in case of error, fails in strict mode *) val warnf : ('a, Format.formatter, unit) format -> 'a -(** a section is a part of infer that can be affected by an infer option *) -type section = - Analysis | BufferOverrun | Checkers | Clang | Crashcontext | Driver | Java | Print +type parse_mode = + | InferCommand (** parse arguments as arguments for infer *) + | Javac (** parse arguments passed to the Java compiler *) + | NoParse (** all arguments are anonymous arguments, no parsing is attempted *) [@@deriving compare] -val all_sections : section list - -type 'a parse = Differential | Infer of 'a | Javac | NoParse +(** Main modes of operation for infer *) +type command = + | Analyze (** analyze previously captured source files *) + | Capture (** capture compilation commands and translate source files into infer's intermediate + language *) + | Clang (** run and accept the same arguments as the clang compiler, may also capture the source + files compiled, and may also not actually compile the files depending on other options + *) + | Compile (** set up the infer environment then run the compilation commands without capturing the + source files *) + | Report (** post-process infer results and reports *) + | ReportDiff (** compute the difference of two infer reports *) + | Run (** orchestrate the capture, analysis, and reporting of a compilation command *) +[@@deriving compare] -type parse_mode = section list parse [@@deriving compare] +val equal_command : command -> command -> bool -type parse_action = section parse [@@deriving compare] +val all_commands : command list val is_originator : bool @@ -43,15 +55,15 @@ val init_work_dir : string - [f] specifies a transformation to be performed on the parsed value before setting the config variable - [symbols] is an association list sometimes used in place of [f] - - [parse_mode] declares which parse mode the option is for. In the case of Infer, that includes - the sections for which the option should be included in the external documentation (--help), - otherwise it appears only in --help-full + - [parse_mode] declares which parse mode the option is for + - [in_help] indicates the man pages in which the command should be documented, as generated by + calling infer with --help. Otherwise it appears only in --help-full. - [meta] is a meta-variable naming the parsed value for documentation purposes - a documentation string *) type 'a t = ?deprecated:string list -> long:string -> ?short:char -> - ?parse_mode:parse_mode -> ?meta:string -> string -> + ?parse_mode:parse_mode -> ?in_help:(command * string) list -> ?meta:string -> string -> 'a (** [mk_set variable value] defines a command line option which sets [variable] to [value]. *) @@ -128,43 +140,80 @@ val mk_anon : unit -> string list ref reverse order they appeared on the command line. For example, calling [mk_rest] and parsing [exe -opt1 -opt2 -- arg1 arg2] will result in the returned ref containing [arg2; arg1]. *) val mk_rest : - ?parse_mode:parse_mode -> string -> + ?parse_mode:parse_mode-> ?in_help:(command * string) list -> string -> string list ref -(** [mk_rest_actions doc ~usage command_to_parse_action] defines a [string list ref] of the command +(** [mk_rest_actions doc ~usage command_to_parse_mode] defines a [string list ref] of the command line arguments following ["--"], in the reverse order they appeared on the command line. [usage] is the usage message in case of parse errors or if --help is passed. For example, calling [mk_action] and parsing [exe -opt1 -opt2 -- arg1 arg2] will result in the returned ref containing [arg2; arg1]. Additionally, the first arg following ["--"] is passed to - [command_to_parse_action] to obtain the parse action that will be used to parse the remaining + [command_to_parse_mode] to obtain the parse action that will be used to parse the remaining arguments. *) val mk_rest_actions : - ?parse_mode:parse_mode -> string -> - usage:string -> (string -> parse_action) + ?parse_mode:parse_mode -> ?in_help:(command * string) list -> string -> + usage:string -> (string -> parse_mode) -> string list ref - -(** When the option is found on the command line, either as [--long] or [name], the current parse - action is discarded and the following arguments are parsed using [parse_action]. [name] defaults - to [long]. *) -val mk_switch_parse_action : parse_action -> usage:string -> ?deprecated:string list -> - long:string -> ?name:string -> ?parse_mode:section list parse -> ?meta:string -> string -> unit +type command_doc + +(** [mk_command_doc ~title ~section ~version ~short_description ~synopsis ~description ~see_also + command_exe] records information about a command that is used to create its man page. A lot of + the concepts are taken from man-pages(7). + + - [command_exe] is the name of the command, preferably an executable that selects the command + - [title] will be the title of the manual + - [section] will be the section of the manual (the number 7 in man-pages(7)) + - [version] is the version string of the command + - [date] is the date of the last modification of the manual + - [short_description] is a one-line description of the command + - [options] if specified, will populate the OPTIONS section; otherwise, the options are taken + from the command's + - All the other [section_name] options correspond to the contents of the section [section_name]. + Some are mandatory and some are not. +*) +val mk_command_doc : title:string -> section:int -> version:string -> date:string -> + short_description:string -> synopsis:Cmdliner.Manpage.block list -> + description:Cmdliner.Manpage.block list -> + ?options:Cmdliner.Manpage.block list -> + ?exit_status:Cmdliner.Manpage.block list -> + ?environment:Cmdliner.Manpage.block list -> + ?files:Cmdliner.Manpage.block list -> + ?notes:Cmdliner.Manpage.block list -> + ?bugs:Cmdliner.Manpage.block list -> + ?examples:Cmdliner.Manpage.block list -> + see_also:Cmdliner.Manpage.block list -> + string -> command_doc + +(** [mk_subcommand command ~long command_doc] defines the subcommand [command]. A subcommand is + activated by passing [--long], [name], or any [-key] for [key] in [deprecated] on the command + line. [name] defaults to [long]. A man page is automatically generated for [command] based on + the information in [command_doc]. *) +val mk_subcommand : command -> ?accept_unknown_args:bool -> + ?deprecated:string list -> long:string -> ?name:string -> + ?parse_mode:parse_mode -> ?in_help:(command * string) list -> command_doc -> unit (** environment variable use to pass arguments from parent to child processes *) val args_env_var : string +val strict_mode_env_var : string + (** separator of argv elements when encoded into environment variables *) val env_var_sep : char (** [extend_env_args args] appends [args] to those passed via [args_env_var] *) val extend_env_args : string list -> unit -(** [parse ~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. +(** [parse ~usage parse_mode command] parses command line arguments as specified by preceding calls + to the [mk_*] functions, and returns: + - the command selected by the user on the command line, except if [command] is not None in which + case it is considered "pre-selected" for the user; + - a function that prints the usage message and help text then exits with the code passed as + argument. 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 - [parse_action] is one that should parse command line arguments (this is defined in the + [parse_mode] is one that should parse command line arguments (this is defined in the implementation of this module). Therefore arguments passed on the command line supersede those specified in the environment variable, which themselves supersede those passed via the config file. @@ -172,7 +221,12 @@ val extend_env_args : string list -> unit 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 set of options parsed in [args_env_var] and on the command line. *) -val parse : ?config_file:string -> usage:Arg.usage_msg -> parse_action -> parse_action * (int -> 'a) +val parse : ?config_file:string -> usage:Arg.usage_msg -> parse_mode -> command option + -> command option * (int -> 'a) (** [is_env_var_set var] is true if $[var]=1 *) val is_env_var_set : string -> bool + +(** Display the manual of [command] to the user, or [command_doc] if [command] is None. If + [internal_section] is true, add a section about internal (hidden) options. *) +val show_manual : ?internal_section:string -> command_doc -> command option -> unit diff --git a/infer/src/base/Config.ml b/infer/src/base/Config.ml index 75e8dad78..37fad3681 100644 --- a/infer/src/base/Config.ml +++ b/infer/src/base/Config.ml @@ -21,11 +21,15 @@ type exe = Analyze | Clang | Driver | Print [@@deriving compare] let equal_exe = [%compare.equal : exe] +(* TODO(16551801) better place to declare analyzers *) +let infer_exe_name = "infer" +let infer_analyze_exe_name = "InferAnalyze" + (** Association list of executable (base)names to their [exe]s. *) let exes = [ - ("InferAnalyze", Analyze); + (infer_analyze_exe_name, Analyze); ("InferClang", Clang); - ("infer", Driver); + (infer_exe_name, Driver); ("InferPrint", Print); ] @@ -34,15 +38,17 @@ let exe_name = fun exe -> List.Assoc.find_exn ~equal:equal_exe exe_to_name exe type analyzer = - | Capture | Compile | Infer | Eradicate | Checkers | Tracing | Crashcontext | Linters + | BiAbduction | CaptureOnly | CompileOnly | Eradicate | Checkers | Tracing | Crashcontext + | Linters [@@deriving compare] let equal_analyzer = [%compare.equal : analyzer] -let string_to_analyzer = - [("capture", Capture); ("compile", Compile); - ("infer", Infer); ("eradicate", Eradicate); ("checkers", Checkers); - ("tracing", Tracing); ("crashcontext", Crashcontext); ("linters", Linters);] +let string_to_analyzer = [ + "capture", CaptureOnly; "checkers", Checkers; "compile", CompileOnly; + "crashcontext", Crashcontext; "eradicate", Eradicate; "infer", BiAbduction; "linters", Linters; + "tracing", Tracing; +] let string_of_analyzer a = List.find_exn ~f:(fun (_, a') -> equal_analyzer a a') string_to_analyzer |> fst @@ -177,6 +183,20 @@ let log_analysis_crash = "C" let log_dir_name = "log" +let manual_buck_compilation_db = "BUCK COMPILATION DATABASE OPTIONS" +let manual_buck_flavors = "BUCK FLAVORS OPTIONS" +let manual_buck_java = "BUCK FOR JAVA OPTIONS" +let manual_buffer_overrun = "BUFFER OVERRUN OPTIONS" +let manual_clang = "CLANG OPTIONS" +let manual_clang_linters = "CLANG LINTERS OPTIONS" +let manual_crashcontext = "CRASHCONTEXT OPTIONS" +let manual_generic = Cmdliner.Manpage.s_options +let manual_internal = "INTERNAL OPTIONS" +let manual_java = "JAVA OPTIONS" +let manual_quandary = "QUANDARY CHECKER OPTIONS" +let manual_siof = "SIOF CHECKER OPTIONS" +let manual_threadsafety = "THREADSAFETY CHECKER OPTIONS" + (** Maximum level of recursion during the analysis, after which a timeout is generated *) let max_recursion = 5 @@ -277,6 +297,12 @@ let current_exe = List.Assoc.find ~equal:String.equal exes (Filename.basename real_exe_name) |> Option.value ~default:Driver +let initial_command = match current_exe with + | Analyze -> Some CLOpt.Analyze + | Clang -> Some CLOpt.Clang + | Driver -> None + | Print -> Some CLOpt.Report + let bin_dir = Filename.dirname real_exe_name @@ -344,29 +370,19 @@ let startup_action = if infer_is_javac then Javac else if !Sys.interactive then NoParse else match current_exe with - | Analyze -> Infer Analysis + | Analyze | Driver | Print -> InferCommand | Clang -> NoParse - | Driver -> Infer Driver - | Print -> Infer Print - - -let exe_usage = match current_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." - | 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 exe_usage = + let exe_command = match current_exe with + | Analyze -> Some "analyze" + | Clang -> Some "clang" + | Print -> Some "report" + | Driver -> None in + Printf.sprintf "%s\nUsage: infer %s [options]\nSee `infer%s --help` for more information." + version_string (Option.value ~default:"command" exe_command) + (Option.value_map ~default:"" ~f:((^) " ") exe_command) (** Command Line options *) @@ -398,23 +414,32 @@ let exe_usage = match current_exe with let anon_args = CLOpt.mk_anon () -and () = - CLOpt.mk_switch_parse_action CLOpt.Differential ~usage:"infer reportdiff [options]" - ~deprecated:["-diff"] ~long:"reportdiff" - "difference (preexisting/introduced/fixed) between two infer reports" - -and abs_struct = +let () = + let command_accepts_unknown_arg = + List.mem ~equal:CLOpt.equal_command CLOpt.[Clang; Report] in + let command_deprecated = + List.Assoc.find ~equal:CLOpt.equal_command CLOpt.[ReportDiff, ["-diff"]] in + (* make sure we generate doc for all the commands we know about *) + List.iter CLOpt.all_commands ~f:(fun cmd -> + let { CommandDoc.long; command_doc } = CommandDoc.data_of_command cmd in + let accept_unknown_args = command_accepts_unknown_arg cmd in + let deprecated = command_deprecated cmd in + CLOpt.mk_subcommand cmd ~long ~accept_unknown_args ?deprecated command_doc) + +let abs_struct = CLOpt.mk_int ~deprecated:["absstruct"] ~long:"abs-struct" ~default:1 - ~meta:"int" "Specify abstraction level for fields of structs:\n\ - - 0 = no\n\ - - 1 = forget some fields during matching (and so lseg abstraction)" + ~meta:"int" + "Specify abstraction level for fields of structs:\n\ + - 0 = no\n\ + - 1 = forget some fields during matching (and so lseg abstraction)\n" and abs_val = CLOpt.mk_int ~deprecated:["absval"] ~long:"abs-val" ~default:2 - ~meta:"int" "Specify abstraction level for expressions:\n\ - - 0 = no abstraction\n\ - - 1 = evaluate all expressions abstractly\n\ - - 2 = 1 + abstract constant integer values during join" + ~meta:"int" + "Specify abstraction level for expressions:\n\ + - 0 = no abstraction\n\ + - 1 = evaluate all expressions abstractly\n\ + - 2 = 1 + abstract constant integer values during join\n" and allow_leak = @@ -440,7 +465,7 @@ and ( ignore ( let long = "-" ^ suffix in CLOpt.mk_string_list ~long ~meta ~f:(fun _ -> raise (Arg.Bad "invalid option")) - ~parse_mode:CLOpt.(Infer [Driver;Print]) + ~in_help:CLOpt.[Report, manual_generic; Run, manual_generic] help ); List.map ~f:(fun (name, analyzer) -> (analyzer, mk_option name)) string_to_analyzer in @@ -449,14 +474,14 @@ and ( ~suffix:"blacklist-files-containing" ~deprecated_suffix:["blacklist_files_containing"] ~help:"blacklist files containing the specified string for the given analyzer (see \ - --analyzer for valid values)" + $(b,--analyzer) for valid values)" ~meta:"string", mk_filtering_options ~suffix:"blacklist-path-regex" ~deprecated_suffix:["blacklist"] ~help:"blacklist the analysis of files whose relative path matches the specified OCaml-style \ regex\n\ - (to whitelist: ---whitelist-path-regex)" + (to whitelist: $(b,---whitelist-path-regex))" ~meta:"path regex", mk_filtering_options ~suffix:"whitelist-path-regex" @@ -474,18 +499,22 @@ and analysis_stops = "Issue a warning when the analysis stops" and analyzer = - let () = match Infer with + let () = match BiAbduction with (* NOTE: if compilation fails here, it means you have added a new analyzer without updating the documentation of this option *) - | Capture | Compile | Infer | Eradicate | Checkers | Tracing | Crashcontext | Linters -> () in + | BiAbduction | CaptureOnly | CompileOnly | Eradicate | Checkers | Tracing | Crashcontext + | Linters -> () in CLOpt.mk_symbol_opt ~deprecated:["analyzer"] ~long:"analyzer" ~short:'a' - ~parse_mode:CLOpt.(Infer [Driver]) + ~in_help:CLOpt.[Analyze, manual_generic; Run, manual_generic] "Specify which analyzer to run (only one at a time is supported):\n\ - - infer, eradicate, checkers: run the specified analysis\n\ - - capture: run capture phase only (no analysis)\n\ - - compile: run compilation command without interfering (not supported by all frontends)\n\ - - crashcontext, tracing: experimental (see --crashcontext and --tracing)\n\ - - linters: run linters based on the ast only (Objective-C and Objective-C++ only)" + - $(b,infer): run the bi-abduction based checker, in particular to check for memory errors \ + (activated by default)\n\ + - $(b,checkers), $(b,eradicate): run the specified analysis\n\ + - $(b,capture): similar to specifying the $(b,capture) subcommand (DEPRECATED)\n\ + - $(b,compile): similar to specifying the $(b,compile) subcommand (DEPRECATED)\n\ + - $(b,crashcontext), $(b,tracing): experimental (see $(b,--crashcontext) and $(b,--tracing))\n\ + - $(b,linters): run linters based on the ast only (Objective-C and Objective-C++ only, \ + activated by default)" ~symbols:string_to_analyzer and android_harness = @@ -498,7 +527,7 @@ and angelic_execution = and annotation_reachability = CLOpt.mk_json ~long:"annotation-reachability" - ~parse_mode:CLOpt.(Infer [Analysis]) + ~in_help:CLOpt.[Analyze, manual_java] "Specify custom sources/sink for the annotation reachability checker\n\ Example format: for custom annotations com.my.annotation.{Source1,Source2,Sink1}\n\ { \"sources\" : [\"Source1\", \"Source2\"], \"sink\" : \"Sink1\" }" @@ -509,29 +538,28 @@ and array_level = - 0 = treats both features soundly\n\ - 1 = assumes that the size of every array is infinite\n\ - 2 = assumes that all heap dereferences via array indexing and pointer \ - arithmetic are correct" + arithmetic are correct\n" and ast_file = CLOpt.mk_path_opt ~deprecated:["ast"] ~long:"ast-file" ~meta:"file" "AST file for the translation" and biabduction = - CLOpt.mk_bool ~long:"biabduction" ~parse_mode:CLOpt.(Infer [Checkers]) + CLOpt.mk_bool ~long:"biabduction" ~in_help:CLOpt.[Analyze, manual_generic] "the separation logic based bi-abduction analysis using the checkers framework" and blacklist = CLOpt.mk_string_opt ~deprecated:["-blacklist-regex";"-blacklist"] ~long:"buck-blacklist" - ~parse_mode:CLOpt.(Infer [Driver]) - ~meta:"regex" "Skip analysis of files matched by the specified regular expression (Buck \ - flavors only)" + ~in_help:CLOpt.[Run, manual_buck_flavors; Capture, manual_buck_flavors] + ~meta:"regex" "Skip analysis of files matched by the specified regular expression" and bootclasspath = CLOpt.mk_string_opt ~long:"bootclasspath" - ~parse_mode:CLOpt.(Infer [Java]) + ~in_help:CLOpt.[Capture, manual_java] "Specify the Java bootclasspath" and bo_debug = CLOpt.mk_int ~default:0 ~long:"bo-debug" - ~parse_mode:CLOpt.(Infer [BufferOverrun]) "Debug mode for buffer-overrun checker" + ~in_help:CLOpt.[Analyze, manual_buffer_overrun] "Debug mode for buffer-overrun checker" (** Automatically set when running from within Buck *) and buck = @@ -540,58 +568,59 @@ and buck = and buck_build_args = CLOpt.mk_string_list ~long:"Xbuck" - ~parse_mode:CLOpt.(Infer [Driver]) - "Pass values as command-line arguments to invocations of `buck build` (Buck flavors only)" + ~in_help:CLOpt.[Capture, manual_buck_flavors] + "Pass values as command-line arguments to invocations of $(i,`buck build`)" and buck_compilation_database = CLOpt.mk_symbol_opt ~long:"buck-compilation-database" ~deprecated:["-use-compilation-database"] - ~parse_mode:CLOpt.(Infer [Driver]) + ~in_help:CLOpt.[Capture, manual_buck_compilation_db] "Buck integration using the compilation database, with or without dependencies." ~symbols:[("deps", `Deps); ("no-deps", `NoDeps)] and buck_out = CLOpt.mk_path_opt ~long:"buck-out" - ~parse_mode:CLOpt.(Infer [Driver]) ~meta:"dir" "Specify the root directory of buck-out" + ~in_help:CLOpt.[Capture, manual_buck_java] ~meta:"dir" "Specify the root directory of buck-out" and bufferoverrun = - CLOpt.mk_bool ~long:"bufferoverrun" ~parse_mode:CLOpt.(Infer [Checkers]) + CLOpt.mk_bool ~long:"bufferoverrun" ~in_help:CLOpt.[Analyze, manual_generic] "the buffer overrun analysis" and bugs_csv = CLOpt.mk_path_opt ~deprecated:["bugs"] ~long:"issues-csv" - ~parse_mode:CLOpt.(Infer [Driver;Print]) + ~in_help:CLOpt.[Report, manual_generic] ~meta:"file" "Write a list of issues in CSV format to a file" and bugs_json = CLOpt.mk_path_opt ~deprecated:["bugs_json"] ~long:"issues-json" - ~parse_mode:CLOpt.(Infer [Driver;Print]) + ~in_help:CLOpt.[Report, manual_generic] ~meta:"file" "Write a list of issues in JSON format to a file" and bugs_tests = CLOpt.mk_path_opt ~long:"issues-tests" - ~parse_mode:CLOpt.(Infer [Driver;Print]) + ~in_help:CLOpt.[Report, manual_generic] ~meta:"file" "Write a list of issues in a format suitable for tests to a file" and bugs_txt = CLOpt.mk_path_opt ~deprecated:["bugs_txt"] ~long:"issues-txt" - ~parse_mode:CLOpt.(Infer [Driver;Print]) + ~in_help:CLOpt.[Report, manual_generic] ~meta:"file" "Write a list of issues in TXT format to a file" and calls_csv = CLOpt.mk_path_opt ~deprecated:["calls"] ~long:"calls-csv" - ~parse_mode:CLOpt.(Infer [Driver;Print]) + ~in_help:CLOpt.[Report, manual_generic] ~meta:"file" "Write individual calls in CSV format to a file" and changed_files_index = - CLOpt.mk_path_opt ~long:"changed-files-index" ~parse_mode:CLOpt.(Infer [Driver]) ~meta:"file" + CLOpt.mk_path_opt ~long:"changed-files-index" ~in_help:CLOpt.[Analyze, manual_generic] + ~meta:"file" "Specify the file containing the list of source files from which reactive analysis should \ start. Source files should be specified relative to project root or be absolute" and checkers_repeated_calls = - CLOpt.mk_bool ~long:"checkers-repeated-calls" ~parse_mode:CLOpt.(Infer [Checkers]) + CLOpt.mk_bool ~long:"checkers-repeated-calls" ~in_help:CLOpt.[Analyze, manual_generic] "check for repeated calls" and checkers, eradicate = @@ -607,14 +636,15 @@ and checkers, eradicate = (checkers, eradicate) and clang_biniou_file = - CLOpt.mk_path_opt ~long:"clang-biniou-file" ~parse_mode:CLOpt.(Infer [Clang]) ~meta:"file" + CLOpt.mk_path_opt ~long:"clang-biniou-file" + ~in_help:CLOpt.[Capture, manual_clang] ~meta:"file" "Specify a file containing the AST of the program, in biniou format" and clang_compilation_dbs = ref [] and clang_frontend_action = CLOpt.mk_symbol_opt ~long:"clang-frontend-action" - ~parse_mode:CLOpt.(Infer [Clang]) + ~in_help:CLOpt.[Capture, manual_clang; Run, manual_clang] "Specify whether the clang frontend should capture or lint or both." ~symbols:clang_frontend_action_symbols @@ -644,20 +674,20 @@ and cluster = and compilation_database = CLOpt.mk_path_list ~long:"compilation-database" ~deprecated:["-clang-compilation-db-files"] - ~parse_mode:CLOpt.(Infer [Clang]) + ~in_help:CLOpt.[Capture, manual_clang] "File that contain compilation commands (can be specified multiple times)" and compilation_database_escaped = CLOpt.mk_path_list ~long:"compilation-database-escaped" ~deprecated:["-clang-compilation-db-files-escaped"] - ~parse_mode:CLOpt.(Infer [Clang]) + ~in_help:CLOpt.[Capture, manual_clang] "File that contain compilation commands where all entries are escaped for the shell, eg coming \ from Xcode (can be specified multiple times)" and compute_analytics = CLOpt.mk_bool ~long:"compute-analytics" ~default:false - ~parse_mode:CLOpt.(Infer [Clang]) + ~in_help:CLOpt.[Capture, manual_clang; Run, manual_clang] "Emit analytics as info-level issues, like component kit line count and \ component kit file cyclomatic complexity" @@ -665,7 +695,7 @@ and compute_analytics = If a procedure was changed beforehand, keep the changed marking. *) and continue = CLOpt.mk_bool ~deprecated:["continue"] ~long:"continue" - ~parse_mode:CLOpt.(Infer [Driver]) + ~in_help:CLOpt.[Analyze, manual_generic] "Continue the capture for the reactive analysis, increasing the changed files/procedures. (If \ a procedure was changed beforehand, keep the changed marking.)" @@ -674,13 +704,13 @@ and copy_propagation = "Perform copy-propagation on the IR" and crashcontext = - CLOpt.mk_bool ~long:"crashcontext" ~parse_mode:CLOpt.(Infer [Checkers]) + CLOpt.mk_bool ~long:"crashcontext" ~in_help:CLOpt.[Analyze, manual_generic] "the crashcontext checker for Java stack trace context reconstruction" and cxx = CLOpt.mk_bool ~deprecated:["cxx-experimental"] ~long:"cxx" ~default:true - ~parse_mode:CLOpt.(Infer [Clang]) + ~in_help:CLOpt.[Capture, manual_clang] "Analyze C++ methods" and ( @@ -712,7 +742,7 @@ and ( and filtering = CLOpt.mk_bool ~deprecated_no:["nf"] ~long:"filtering" ~short:'f' ~default:true - ~parse_mode:CLOpt.(Infer [Driver]) + ~in_help:CLOpt.[Report, manual_generic] "Do not show the results from experimental checks (note: some of them may contain many false \ alarms)" @@ -747,9 +777,10 @@ and ( in let debug = CLOpt.mk_bool_group ~deprecated:["debug"] ~long:"debug" ~short:'g' - ~parse_mode:CLOpt.(Infer [Driver]) - "Debug mode (also sets --developer-mode, --no-filtering, --print-buckets, --print-types, \ - --reports-include-ml-loc, --no-test, --trace-error, --write-dotty, --write-html)" + ~in_help:CLOpt.[Capture, manual_generic; Report, manual_generic; Run, manual_generic] + "Debug mode (also sets $(b,--developer-mode), $(b,--no-filtering), $(b,--print-buckets), \ + $(b,--print-types), $(b,--reports-include-ml-loc), $(b,--no-test), $(b,--trace-error), \ + $(b,--write-dotty), $(b,--write-html))" [developer_mode; print_buckets; print_types; reports_include_ml_loc; trace_error; write_html; write_dotty] [filtering; test] @@ -757,31 +788,35 @@ and ( and debug_exceptions = CLOpt.mk_bool_group ~long:"debug-exceptions" "Generate lightweight debugging information: just print the internal exceptions during \ - analysis (also sets --developer-mode, --no-filtering, --print-buckets, \ - --reports-include-ml-loc)" + analysis (also sets $(b,--developer-mode), $(b,--no-filtering), $(b,--print-buckets), \ + $(b,--reports-include-ml-loc))" [developer_mode; print_buckets; reports_include_ml_loc] [filtering] and default_linters = - CLOpt.mk_bool ~long:"default-linters" ~parse_mode:CLOpt.(Infer [Clang]) ~default:true + CLOpt.mk_bool ~long:"default-linters" ~in_help:CLOpt.[Capture, manual_clang; Run, manual_clang] + ~default:true "Use the default linters for the analysis." and frontend_tests = CLOpt.mk_bool_group ~long:"frontend-tests" - ~parse_mode:CLOpt.(Infer [Clang]) + ~in_help:CLOpt.[Capture, manual_clang] "Save filename.ext.test.dot with the cfg in dotty format for frontend tests (also sets \ - --print-types)" + $(b,--print-types))" [print_types] [] and print_logs = - CLOpt.mk_bool ~long:"print-logs" ~parse_mode:CLOpt.(Infer [Driver]) + CLOpt.mk_bool ~long:"print-logs" + ~in_help:CLOpt.[Analyze, manual_generic; Capture, manual_generic; Run, manual_generic; + Report, manual_generic] "Also log messages to stdout and stderr" in let linters_developer_mode = - CLOpt.mk_bool_group ~long:"linters-developer-mode" ~parse_mode:CLOpt.(Infer [Clang]) - "Debug mode for developing new linters. (Sets the analyzer to \"linters\"; also sets \ - --debug, --developer-mode, --print-logs, and \ - unsets --allowed-failures and --default-linters." + CLOpt.mk_bool_group ~long:"linters-developer-mode" + ~in_help:CLOpt.[Capture, manual_clang; Run, manual_clang] + "Debug mode for developing new linters. (Sets the analyzer to $(b,linters); also sets \ + $(b,--debug), $(b,--developer-mode), $(b,--print-logs), and \ + unsets $(b,--allowed-failures) and $(b,--default-linters)." [debug; developer_mode; print_logs] [failures_allowed; default_linters] in ( @@ -805,13 +840,13 @@ and ( and dependencies = CLOpt.mk_bool ~deprecated:["dependencies"] ~long:"dependencies" - ~parse_mode:CLOpt.(Infer [Java]) + ~in_help:CLOpt.[Capture, manual_java] "Translate all the dependencies during the capture. The classes in the given jar file will be \ translated. No sources needed." and disable_checks = CLOpt.mk_string_list ~deprecated:["disable_checks"] ~long:"disable-checks" ~meta:"error name" - ~parse_mode:CLOpt.(Infer [Driver;Print]) + ~in_help:CLOpt.[Report, manual_generic] "Do not show reports coming from this type of errors" and dotty_cfg_libs = @@ -819,7 +854,7 @@ and dotty_cfg_libs = "Print the cfg of the code coming from the libraries" and dump_duplicate_symbols = - CLOpt.mk_bool ~long:"dump-duplicate-symbols" ~parse_mode:CLOpt.(Infer [Clang]) + CLOpt.mk_bool ~long:"dump-duplicate-symbols" ~in_help:CLOpt.[Capture, manual_clang] "Dump all symbols with the same name that are defined in more than one file." and dynamic_dispatch = @@ -873,7 +908,7 @@ and err_file = and fail_on_bug = CLOpt.mk_bool ~deprecated:["-fail-on-bug"] ~long:"fail-on-issue" ~default:false - ~parse_mode:CLOpt.(Infer [Driver]) + ~in_help:CLOpt.[Run, manual_generic] (Printf.sprintf "Exit with error code %d if Infer found something to report" fail_on_issue_exit_code) @@ -887,7 +922,7 @@ and fcp_syntax_only = and file_renamings = CLOpt.mk_path_opt - ~long:"file-renamings" ~parse_mode:CLOpt.Differential + ~long:"file-renamings" ~in_help:CLOpt.[ReportDiff, manual_generic] "JSON with a list of file renamings to use while computing differential reports" and filter_paths = @@ -896,26 +931,26 @@ and filter_paths = and filter_report_paths = CLOpt.mk_string_opt - ~long:"filter-report-paths" ~parse_mode:CLOpt.(Infer [Print]) + ~long:"filter-report-paths" ~in_help:CLOpt.[Report, manual_generic] "Specify the file containing a newline-separated list of files for which to emit a report. \ Source files should be specified relative to project root or be absolute." and flavors = CLOpt.mk_bool ~deprecated:["-use-flavors"] ~long:"flavors" - ~parse_mode:CLOpt.(Infer [Driver]) - "Buck integration using Buck flavors (clang only), eg `infer --flavors -- buck build \ - //foo:bar#infer`" + ~in_help:CLOpt.[Capture, manual_buck_flavors] + "Buck integration using Buck flavors (clang only), eg $(i,`infer --flavors -- buck build \ + //foo:bar#infer`)" and from_json_report = CLOpt.mk_path_opt ~long:"from-json-report" - ~parse_mode:CLOpt.(Infer [Print]) + ~in_help:CLOpt.[Report, manual_generic] ~meta:"report.json" "Load analysis results from a report file (default is to load the results from the specs \ files generated by the analysis)." and frontend_debug = CLOpt.mk_bool ~deprecated:["fd"] ~deprecated_no:["nfd"] ~long:"frontend-debug" - ~parse_mode:CLOpt.(Infer [Clang]) + ~in_help:CLOpt.[Capture, manual_clang] "Emit debug info to *.o.astlog and a script *.o.sh that replays the command used to run clang \ with the plugin attached, piped to the InferClang frontend command" @@ -925,14 +960,24 @@ and frontend_stats = and generated_classes = CLOpt.mk_path_opt ~long:"generated-classes" - ~parse_mode:CLOpt.(Infer [Java]) + ~in_help:CLOpt.[Capture, manual_java] "Specify where to load the generated class files" and headers = CLOpt.mk_bool ~deprecated:["headers"; "hd"] ~deprecated_no:["no_headers"; "nhd"] ~long:"headers" - ~parse_mode:CLOpt.(Infer [Clang]) + ~in_help:CLOpt.[Capture, manual_clang] "Analyze code in header files" +and help = + let var = ref `None in + CLOpt.mk_set var `Help ~long:"help" + ~in_help:(List.map CLOpt.all_commands ~f:(fun command -> command, manual_generic)) + "Show this manual" ; + CLOpt.mk_set var `HelpFull ~long:"help-full" + ~in_help:(List.map CLOpt.all_commands ~f:(fun command -> command, manual_generic)) + (Printf.sprintf "Show this manual with all internal options in the %s section" manual_internal); + var + and icfg_dotty_outfile = CLOpt.mk_path_opt ~long:"icfg-dotty-outfile" ~meta:"path" "If set, specifies path where .dot file should be written, it overrides the path for all \ @@ -943,12 +988,13 @@ and infer_cache = ~meta:"dir" "Select a directory to contain the infer cache (Buck and Java only)" and iphoneos_target_sdk_version = - CLOpt.mk_string_opt ~long:"iphoneos-target-sdk-version" ~parse_mode:CLOpt.(Infer [Clang]) + CLOpt.mk_string_opt ~long:"iphoneos-target-sdk-version" + ~in_help:CLOpt.[Capture, manual_clang_linters] "Specify the target SDK version to use for iphoneos" and issues_fields = CLOpt.mk_symbol_seq ~long:"issues-fields" - ~parse_mode:CLOpt.(Infer [Print]) + ~in_help:CLOpt.[Report, manual_generic] ~default:[ `Issue_field_file; `Issue_field_procedure; @@ -957,7 +1003,7 @@ and issues_fields = `Issue_field_bug_trace; ] ~symbols:issues_fields_symbols ~eq:PVariant.(=) - "Fields to emit with --issues-tests" + "Fields to emit with $(b,--issues-tests)" and iterations = CLOpt.mk_int ~deprecated:["iterations"] ~long:"iterations" ~default:1 @@ -972,14 +1018,14 @@ and java_jar_compiler = and jobs = CLOpt.mk_int ~deprecated:["-multicore"] ~long:"jobs" ~short:'j' ~default:ncpu - ~parse_mode:CLOpt.(Infer [Driver]) + ~in_help:CLOpt.[Analyze, manual_generic] ~meta:"int" "Run the specified number of analysis jobs simultaneously" and join_cond = CLOpt.mk_int ~deprecated:["join_cond"] ~long:"join-cond" ~default:1 ~meta:"int" "Set the strength of the final information-loss check used by the join:\n\ - 0 = use the most aggressive join for preconditions\n\ - - 1 = use the least aggressive join for preconditions" + - 1 = use the least aggressive join for preconditions\n" and latex = CLOpt.mk_path_opt ~deprecated:["latex"] ~long:"latex" @@ -987,30 +1033,30 @@ and latex = "Write a latex report of the analysis results to a file" and linter = - CLOpt.mk_string_opt ~long:"linter" ~parse_mode:CLOpt.(Infer [Clang]) + CLOpt.mk_string_opt ~long:"linter" ~in_help:CLOpt.[Capture, manual_clang_linters] "From the linters available, only run this one linter. \ - (Useful together with --linters-developer-mode)" + (Useful together with $(b,--linters-developer-mode))" and linters_def_file = CLOpt.mk_path_list ~default:[] - ~long:"linters-def-file" ~parse_mode:CLOpt.(Infer [Clang]) + ~long:"linters-def-file" ~in_help:CLOpt.[Capture, manual_clang_linters] ~meta:"file" "Specify the file containing linters definition (e.g. 'linters.al')" and linters_ignore_clang_failures = CLOpt.mk_bool ~long:"linters-ignore-clang-failures" - ~parse_mode:CLOpt.(Infer [Clang]) + ~in_help:CLOpt.[Capture, manual_clang_linters] ~default:false "Continue linting files even if some compilation fails." and load_average = CLOpt.mk_float_opt ~long:"load-average" ~short:'l' - ~parse_mode:CLOpt.(Infer [Driver]) ~meta:"float" + ~in_help:CLOpt.[Capture, manual_generic] ~meta:"float" "Do not start new parallel jobs if the load average is greater than that specified (Buck and \ make only)" and load_results = CLOpt.mk_path_opt ~deprecated:["load_results"] ~long:"load-results" - ~parse_mode:CLOpt.(Infer [Print]) + ~in_help:CLOpt.[Report, manual_generic] ~meta:"file.iar" "Load analysis results from Infer Analysis Results file file.iar" (** name of the makefile to create with clusters and dependencies *) @@ -1024,18 +1070,18 @@ and margin = and merge = CLOpt.mk_bool ~deprecated:["merge"] ~long:"merge" - ~parse_mode:CLOpt.(Infer [Driver]) - "Merge the captured results directories specified in the dependency file (Buck flavors only)" + ~in_help:CLOpt.[Analyze, manual_buck_flavors] + "Merge the captured results directories specified in the dependency file" and ml_buckets = CLOpt.mk_symbol_seq ~deprecated:["ml_buckets"; "-ml_buckets"] ~long:"ml-buckets" ~default:[`MLeak_cf] - ~parse_mode:CLOpt.(Infer [Clang]) + ~in_help:CLOpt.[Analyze, manual_clang] "Specify the memory leak buckets to be checked in Objective-C/C++:\n\ - - 'cf' checks leaks from Core Foundation,\n\ - - 'arc' from code compiled in ARC mode,\n\ - - 'narc' from code not compiled in ARC mode,\n\ - - 'cpp' from C++ code" + - $(b,cf) checks leaks from Core Foundation (activated by default),\n\ + - $(b,arc) from code compiled in ARC mode,\n\ + - $(b,narc) from code not compiled in ARC mode,\n\ + - $(b,cpp) from C++ code\n" ~symbols:ml_bucket_symbols ~eq:PVariant.(=) and models_mode = @@ -1078,7 +1124,7 @@ and patterns_never_returning_null = let long = "never-returning-null" in (long, CLOpt.mk_json ~deprecated:["never_returning_null"] ~long - "Matcher or list of matchers for functions that never return `null`.") + "Matcher or list of matchers for functions that never return $(i,null).") and patterns_skip_translation = let long = "skip-translation" in @@ -1093,7 +1139,7 @@ and per_procedure_parallelism = and pmd_xml = CLOpt.mk_bool ~long:"pmd-xml" - ~parse_mode:CLOpt.(Infer [Driver]) + ~in_help:CLOpt.[Run, manual_generic] "Output issues in (PMD) XML format" and precondition_stats = @@ -1111,8 +1157,8 @@ and print_using_diff = and procedures_per_process = CLOpt.mk_int ~long:"procedures-per-process" ~default:1000 ~meta:"int" "Specify the number of procedures to analyze per process when using \ - --per-procedure-parallelism. If 0 is specified, each file is divided into --jobs groups of \ - procedures." + $(b,--per-procedure-parallelism). If 0 is specified, each file is divided into $(b,--jobs) \ + groups of procedures." and procs_csv = CLOpt.mk_path_opt ~deprecated:["procs"] ~long:"procs-csv" @@ -1122,55 +1168,57 @@ and procs_xml = CLOpt.mk_path_opt ~deprecated:["procs_xml"] ~long:"procs-xml" ~meta:"file" "Write statistics for each procedure in XML format to a file (as a path relative to \ - --results-dir)" + $(b,--results-dir))" and progress_bar = CLOpt.mk_bool ~deprecated:["pb"] ~deprecated_no:["no_progress_bar"; "npb"] ~short:'p' ~long:"progress-bar" ~default:true - ~parse_mode:CLOpt.(Infer [Driver]) + ~in_help:CLOpt.[Run, manual_generic] "Show a progress bar" and project_root = CLOpt.mk_path ~deprecated:["project_root"; "-project_root"; "pr"] ~long:"project-root" ~short:'C' ~default:CLOpt.init_work_dir - ~parse_mode:CLOpt.(Infer [Analysis;Clang;Driver;Print]) + ~in_help:CLOpt.[Analyze, manual_generic; Capture, manual_generic; Run, manual_generic; + Report, manual_generic] ~meta:"dir" "Specify the root directory of the project" and quandary = - CLOpt.mk_bool ~long:"quandary" ~parse_mode:CLOpt.(Infer [Checkers]) + CLOpt.mk_bool ~long:"quandary" ~in_help:CLOpt.[Analyze, manual_generic] "the quandary taint analysis" and quandary_endpoints = CLOpt.mk_json ~long:"quandary-endpoints" - ~parse_mode:CLOpt.(Infer [Checkers]) + ~in_help:CLOpt.[Analyze, manual_quandary] "Specify endpoint classes for Quandary" and quandary_sources = CLOpt.mk_json ~long:"quandary-sources" - ~parse_mode:CLOpt.(Infer [Checkers]) + ~in_help:CLOpt.[Analyze, manual_quandary] "Specify custom sources for Quandary" and quandary_sinks = CLOpt.mk_json ~long:"quandary-sinks" - ~parse_mode:CLOpt.(Infer [Checkers]) + ~in_help:CLOpt.[Analyze, manual_quandary] "Specify custom sinks for Quandary" and quiet = - CLOpt.mk_bool ~long:"quiet" ~short:'q' ~default:(current_exe <> Print) - ~parse_mode:CLOpt.(Infer [Print]) - "Do not print specs on standard output" + CLOpt.mk_bool ~long:"quiet" ~short:'q' ~default:false + ~in_help:CLOpt.[Analyze, manual_generic; Report, manual_generic] + "Do not print specs on standard output (default: only print for the $(b,report) command)" and reactive = CLOpt.mk_bool ~deprecated:["reactive"] ~long:"reactive" ~short:'r' - ~parse_mode:CLOpt.(Infer [Driver]) - "Reactive mode: the analysis starts from the files captured since the `infer` command started" + ~in_help:CLOpt.[Analyze, manual_generic] + "Reactive mode: the analysis starts from the files captured since the $(i,infer) command \ + started" and reactive_capture = CLOpt.mk_bool ~long:"reactive-capture" "Compile source files only when required by analyzer (clang only)" and report_current = - CLOpt.mk_path_opt ~long:"report-current" ~parse_mode:CLOpt.Differential + CLOpt.mk_path_opt ~long:"report-current" ~in_help:CLOpt.[ReportDiff, manual_generic] "report of the latest revision" and report_custom_error = @@ -1179,7 +1227,7 @@ and report_custom_error = and report_formatter = CLOpt.mk_symbol ~long:"report-formatter" - ~parse_mode:CLOpt.(Infer [Driver; Print]) + ~in_help:CLOpt.[Report, manual_generic] ~default:`Phabricator_formatter ~symbols:[ ("none", `No_formatter); @@ -1192,21 +1240,21 @@ and report_hook = ~default:(lib_dir ^/ "python" ^/ "report.py") ~meta:"script" "Specify a script to be executed after the analysis results are written. This script will be \ - passed --issues-csv, --issues-json, --issues-txt, --issues-xml, --project-root, and \ - --results-dir." + passed $(b,--issues-csv), $(b,--issues-json), $(b,--issues-txt), $(b,--issues-xml), \ + $(b,--project-root), and $(b,--results-dir)." and report_previous = - CLOpt.mk_path_opt ~long:"report-previous" ~parse_mode:CLOpt.Differential - "report of the base revision to use for comparison" + CLOpt.mk_path_opt ~long:"report-previous" ~in_help:CLOpt.[ReportDiff, manual_generic] + "Report of the base revision to use for comparison" and resolve_infer_eradicate_conflict = CLOpt.mk_bool ~long:"resolve-infer-eradicate-conflict" - ~default:false ~parse_mode:CLOpt.Differential + ~default:false ~in_help:CLOpt.[ReportDiff, manual_generic] "Filter out Null Dereferences reported by Infer if Eradicate is enabled" and rest = CLOpt.mk_rest_actions - ~parse_mode:CLOpt.(Infer [Driver]) + ~in_help:CLOpt.[Capture, manual_generic; Run, manual_generic] "Stop argument processing, use remaining arguments as a build command" ~usage:exe_usage (fun build_exe -> @@ -1218,41 +1266,43 @@ and rest = and results_dir = CLOpt.mk_path ~deprecated:["results_dir"; "-out"] ~long:"results-dir" ~short:'o' ~default:(CLOpt.init_work_dir ^/ "infer-out") - ~parse_mode:CLOpt.(Infer [Analysis;Clang;Driver;Print]) + ~in_help:CLOpt.[Analyze, manual_generic; Capture, manual_generic; Run, manual_generic; + Report, manual_generic] ~meta:"dir" "Write results and internal files in the specified directory" and save_results = CLOpt.mk_path_opt ~deprecated:["save_results"] ~long:"save-results" - ~parse_mode:CLOpt.(Infer [Print]) + ~in_help:CLOpt.[Report, manual_generic] ~meta:"file.iar" "Save analysis results to Infer Analysis Results file file.iar" and seconds_per_iteration = CLOpt.mk_float_opt ~deprecated:["seconds_per_iteration"] ~long:"seconds-per-iteration" - ~meta:"float" "Set the number of seconds per iteration (see --iterations)" + ~meta:"float" "Set the number of seconds per iteration (see $(b,--iterations))" and siof = - CLOpt.mk_bool ~long:"siof" ~parse_mode:CLOpt.(Infer [Checkers]) + CLOpt.mk_bool ~long:"siof" ~in_help:CLOpt.[Analyze, manual_generic] "the Static Initialization Order Fiasco analysis (C++ only)" and siof_safe_methods = CLOpt.mk_string_list ~long:"siof-safe-methods" - ~parse_mode:CLOpt.(Infer [Checkers]) + ~in_help:CLOpt.[Analyze, manual_siof] "Methods that are SIOF-safe; \"foo::bar\" will match \"foo::bar()\", \"foo::bar()\", \ etc. (can be specified multiple times)" and skip_analysis_in_path = CLOpt.mk_string_list ~deprecated:["-skip-clang-analysis-in-path"] ~long:"skip-analysis-in-path" - ~parse_mode:CLOpt.(Infer [Driver]) + ~in_help:CLOpt.[Capture, manual_generic; Run, manual_generic] ~meta:"path prefix OCaml regex" "Ignore files whose path matches the given prefix (can be specified multiple times)" and skip_duplicated_types = - CLOpt.mk_bool ~long:"skip-duplicated-types" ~default:true ~parse_mode:CLOpt.Differential + CLOpt.mk_bool ~long:"skip-duplicated-types" ~default:true + ~in_help:CLOpt.[ReportDiff, manual_generic] "Skip fixed-then-introduced duplicated types while computing differential reports" and skip_translation_headers = CLOpt.mk_string_list ~deprecated:["skip_translation_headers"] ~long:"skip-translation-headers" - ~parse_mode:CLOpt.(Infer [Clang]) + ~in_help:CLOpt.[Capture, manual_clang] ~meta:"path prefix" "Ignore headers whose path matches the given prefix" and sources = @@ -1267,7 +1317,7 @@ and spec_abs_level = CLOpt.mk_int ~deprecated:["spec_abs_level"] ~long:"spec-abs-level" ~default:1 ~meta:"int" "Set the level of abstracting the postconditions of discovered specs:\n\ - 0 = nothing special\n\ - - 1 = filter out redundant posts implied by other posts" + - 1 = filter out redundant posts implied by other posts\n" and specs_library = let specs_library = @@ -1292,18 +1342,20 @@ and specs_library = ~long:"specs-library-index" ~default:"" ~f:(fun file -> specs_library := (read_specs_dir_list_file file) @ !specs_library; "") - ~parse_mode:CLOpt.(Infer [Analysis]) ~meta:"file" + ~in_help:CLOpt.[Analyze, manual_generic] ~meta:"file" "" in specs_library and stacktrace = - CLOpt.mk_path_opt ~deprecated:["st"] ~long:"stacktrace" ~parse_mode:CLOpt.(Infer [Crashcontext]) + CLOpt.mk_path_opt ~deprecated:["st"] ~long:"stacktrace" + ~in_help:CLOpt.[Analyze, manual_crashcontext] ~meta:"file" "File path containing a json-encoded Java crash stacktrace. Used to guide the \ analysis (only with '-a crashcontext'). See \ tests/codetoanalyze/java/crashcontext/*.json for examples of the expected format." and stacktraces_dir = - CLOpt.mk_path_opt ~long:"stacktraces-dir" ~parse_mode:CLOpt.(Infer [Crashcontext]) + CLOpt.mk_path_opt ~long:"stacktraces-dir" + ~in_help:CLOpt.[Analyze, manual_crashcontext] ~meta:"dir" "Directory path containing multiple json-encoded Java crash stacktraces. \ Used to guide the analysis (only with '-a crashcontext'). See \ tests/codetoanalyze/java/crashcontext/*.json for examples of the expected format." @@ -1325,7 +1377,7 @@ and svg = and symops_per_iteration = CLOpt.mk_int_opt ~deprecated:["symops_per_iteration"] ~long:"symops-per-iteration" - ~meta:"int" "Set the number of symbolic operations per iteration (see --iterations)" + ~meta:"int" "Set the number of symbolic operations per iteration (see $(b,--iterations))" and test_filtering = CLOpt.mk_bool ~deprecated:["test_filtering"] ~long:"test-filtering" @@ -1338,11 +1390,11 @@ and testing_mode = and threadsafe_aliases = CLOpt.mk_json ~long:"threadsafe-aliases" - ~parse_mode:CLOpt.(Infer [Checkers]) + ~in_help:CLOpt.[Analyze, manual_threadsafety] "Specify custom annotations that should be considered aliases of @ThreadSafe" and threadsafety = - CLOpt.mk_bool ~long:"threadsafety" ~parse_mode:CLOpt.(Infer [Checkers]) + CLOpt.mk_bool ~long:"threadsafety" ~in_help:CLOpt.[Analyze, manual_generic] "the thread safety analysis" and trace_join = @@ -1368,7 +1420,7 @@ and type_size = and unsafe_malloc = CLOpt.mk_bool ~long:"unsafe-malloc" - ~parse_mode:CLOpt.(Infer [Clang]) + ~in_help:CLOpt.[Analyze, manual_clang] "Assume that malloc(3) never returns null." (** Set the path to the javac verbose output *) @@ -1379,10 +1431,10 @@ and verbose_out = and version = let var = ref `None in CLOpt.mk_set var `Full ~deprecated:["version"] ~long:"version" - ~parse_mode:CLOpt.(Infer [Analysis;Clang;Driver;Print]) + ~in_help:CLOpt.[Run, manual_generic] "Print version information and exit" ; CLOpt.mk_set var `Json ~deprecated:["version_json"] ~long:"version-json" - ~parse_mode:CLOpt.(Infer [Analysis;Clang;Driver;Print]) + ~in_help:CLOpt.[Run, manual_generic] "Print version information in json format and exit" ; CLOpt.mk_set var `Vcs ~long:"version-vcs" "Print version control system commit and exit" ; @@ -1408,15 +1460,16 @@ and worklist_mode = and xcode_developer_dir = CLOpt.mk_path_opt ~long:"xcode-developer-dir" - ~parse_mode:CLOpt.(Infer [Clang]) - ~meta:"XCODE_DEVELOPER_DIR" "Specify the path to Xcode developer directory (Buck flavors only)" + ~in_help:CLOpt.[Capture, manual_buck_flavors] + ~meta:"XCODE_DEVELOPER_DIR" "Specify the path to Xcode developer directory" and xcpretty = CLOpt.mk_bool ~long:"xcpretty" ~default:true - ~parse_mode:CLOpt.(Infer [Clang]) + ~in_help:CLOpt.[Capture, manual_clang] "Infer will use xcpretty together with xcodebuild to analyze an iOS app. xcpretty just needs \ - to be in the path, infer command is still just infer -- . (Recommended)" + to be in the path, infer command is still just $(i,`infer -- `). \ + (Recommended)" and xml_specs = CLOpt.mk_bool ~deprecated:["xml"] ~long:"xml-specs" @@ -1459,7 +1512,7 @@ and () = (** Parse Command Line Args *) -let post_parsing_initialization () = +let post_parsing_initialization command_opt = (match !version with | `Full -> (* TODO(11791235) change back to stdout once buck integration is fixed *) @@ -1482,7 +1535,7 @@ let post_parsing_initialization () = let analyzer_name = List.Assoc.find_exn ~equal:equal_analyzer (List.map ~f:(fun (n,a) -> (a,n)) string_to_analyzer) - (match !analyzer with Some a -> a | None -> Infer) in + (match !analyzer with Some a -> a | None -> BiAbduction) in let infer_version = Version.commit in F.eprintf "%s/%s/%s@." javac_version analyzer_name infer_version | `Javac -> @@ -1493,7 +1546,15 @@ let post_parsing_initialization () = print_endline Version.commit | `None -> () ); - if !version <> `None then exit 0; + (match !help with + | `Help -> + CLOpt.show_manual CommandDoc.infer command_opt + | `HelpFull -> + CLOpt.show_manual ~internal_section:manual_internal CommandDoc.infer command_opt + | `None -> + () + ); + if !version <> `None || !help <> `None then exit 0; (* Core sets a verbose exception handler by default, with backtrace. This is good for developers but in user-mode we want something lighter weight. *) @@ -1539,21 +1600,18 @@ let post_parsing_initialization () = if !default_linters then linters_def_file := linters_def_default_file :: !linters_def_file; - match !analyzer with - | Some Checkers -> checkers := true - | Some Crashcontext -> checkers := true; crashcontext := true - | Some Eradicate -> checkers := true; eradicate := true - | Some Tracing -> tracing := true - | Some (Capture | Compile | Infer | Linters) | None -> () - -let inferconfig_env_var = "INFERCONFIG" - -(** Name of the infer configuration file *) -let inferconfig_file = ".inferconfig" + (match !analyzer with + | Some Checkers -> checkers := true + | Some Crashcontext -> checkers := true; crashcontext := true + | Some Eradicate -> checkers := true; eradicate := true + | Some Tracing -> tracing := true + | Some (CaptureOnly | CompileOnly | BiAbduction | Linters) | None -> () + ); + Option.value ~default:CLOpt.Run command_opt let inferconfig_path () = let rec find dir = - match Sys.file_exists ~follow_symlinks:false (dir ^/ inferconfig_file) with + match Sys.file_exists ~follow_symlinks:false (dir ^/ CommandDoc.inferconfig_file) with | `Yes -> Some dir | `No | `Unknown -> @@ -1561,7 +1619,7 @@ let inferconfig_path () = let is_root = String.equal dir parent in if is_root then None else find parent in - match Sys.getenv inferconfig_env_var with + match Sys.getenv CommandDoc.inferconfig_env_var with | Some env_path -> (* make sure the path makes sense in children infer processes *) Some ( @@ -1572,13 +1630,14 @@ let inferconfig_path () = ) | None -> find (Sys.getcwd ()) - |> Option.map ~f:(fun dir -> dir ^/ inferconfig_file) + |> Option.map ~f:(fun dir -> dir ^/ CommandDoc.inferconfig_file) -let parse_action, parse_args_and_return_usage_exit = +let command, parse_args_and_return_usage_exit = let config_file = inferconfig_path () in - let parse_action, usage_exit = CLOpt.parse ?config_file ~usage:exe_usage startup_action in - post_parsing_initialization () ; - parse_action, usage_exit + let command_opt, usage_exit = + CLOpt.parse ?config_file ~usage:exe_usage startup_action initial_command in + let command = post_parsing_initialization command_opt in + command, usage_exit let print_usage_exit () = parse_args_and_return_usage_exit 1 @@ -1664,7 +1723,6 @@ and file_renamings = !file_renamings and filter_paths = !filter_paths and filter_report_paths = !filter_report_paths and filtering = !filtering -and final_parse_action = parse_action and flavors = !flavors and from_json_report = !from_json_report and frontend_debug = !frontend_debug @@ -1790,10 +1848,10 @@ let clang_frontend_do_capture, clang_frontend_do_lint = | None -> match !analyzer with | Some Linters -> false, true (* no capture, lint *) - | Some Infer -> true, false (* capture, no lint *) + | Some BiAbduction -> true, false (* capture, no lint *) | _ -> true, true (* capture, lint *) -let analyzer = match !analyzer with Some a -> a | None -> Infer +let analyzer = match !analyzer with Some a -> a | None -> BiAbduction let clang_frontend_action_string = String.concat ~sep:" and " @@ -1803,7 +1861,7 @@ let clang_frontend_action_string = let dynamic_dispatch = let default_mode = match analyzer with - | Infer + | BiAbduction | Tracing -> `Lazy | Checkers when quandary -> `Sound | _ -> `None in diff --git a/infer/src/base/Config.mli b/infer/src/base/Config.mli index ca9fb065b..7d227ccd8 100644 --- a/infer/src/base/Config.mli +++ b/infer/src/base/Config.mli @@ -10,16 +10,14 @@ open! IStd +module CLOpt = CommandLineOption + (** Configuration values: either constant, determined at compile time, or set at startup time by system calls, environment variables, or command line options *) -type exe = Analyze | Clang | Driver | Print [@@deriving compare] - -val exe_name : exe -> string - -(** Various kind of analyzers *) type analyzer = - | Capture | Compile | Infer | Eradicate | Checkers | Tracing | Crashcontext | Linters + | BiAbduction | CaptureOnly | CompileOnly | Eradicate | Checkers | Tracing | Crashcontext + | Linters [@@deriving compare] val equal_analyzer : analyzer -> analyzer -> bool @@ -101,6 +99,8 @@ val frontend_stats_dir_name : string val global_tenv_filename : string val idempotent_getters : bool val incremental_procs : bool +val infer_exe_name : string +val infer_analyze_exe_name : string val infer_py_argparse_error_exit_code : int val initial_analysis_time : float val ivar_attributes : string @@ -200,6 +200,7 @@ val clang_frontend_do_lint : bool val clang_ignore_regex : string option val clang_include_to_override_regex : string option val cluster_cmdline : string option +val command : CLOpt.command val compute_analytics : bool val continue_capture : bool val default_linters : bool @@ -235,7 +236,6 @@ val file_renamings : string option val filter_paths : bool val filter_report_paths : string option val filtering : bool -val final_parse_action : CommandLineOption.parse_action val flavors : bool val from_json_report : string option val frontend_debug : bool @@ -288,7 +288,6 @@ val no_translate_libs : bool val objc_memory_model_on : bool val only_footprint : bool val out_file_cmdline : string -val parse_action : CommandLineOption.parse_action val pmd_xml : bool val precondition_stats : bool val print_logs : bool diff --git a/infer/src/base/Logging.ml b/infer/src/base/Logging.ml index 0643a3be2..f6b4d4cc4 100644 --- a/infer/src/base/Logging.ml +++ b/infer/src/base/Logging.ml @@ -29,15 +29,12 @@ let dup_formatter fmt1 fmt2 = Format.pp_set_formatter_output_functions fmt1 out_string flush (** Name of dir for logging the output in the specific executable *) -let log_dir_of_action (action : CLOpt.parse_action) = match action with - | Infer (Analysis | BufferOverrun | Checkers | Crashcontext) -> "analyze" - | Differential -> "differential" - | Infer Driver -> "driver" - | Infer Clang - | Infer Java - | NoParse - | Javac -> "capture" - | Infer Print -> "print" +let log_dir_of_command (command : CLOpt.command) = match command with + | Analyze -> "analyze" + | Capture | Clang | Compile -> "capture" + | Report -> "report" + | ReportDiff -> "reportdiff" + | Run -> "driver" let stdout_err_log_files = (((lazy F.std_formatter), (lazy Pervasives.stdout), @@ -54,8 +51,8 @@ let close_log_file fmt chan file = Out_channel.close c ) -let create_log_file action name_prefix outerr = - let log_dir = Config.results_dir ^/ Config.log_dir_name ^/ log_dir_of_action action in +let create_log_file command name_prefix outerr = + let log_dir = Config.results_dir ^/ Config.log_dir_name ^/ log_dir_of_command command in let config_name = match outerr with | `Out -> Config.out_file_cmdline | `Err -> Config.err_file_cmdline in @@ -83,34 +80,36 @@ let create_log_file action name_prefix outerr = "log files flushing"; (file_fmt, chan, file) -let should_setup_log_files (action : CLOpt.parse_action) = match action with - | Infer Analysis - | Infer Clang -> Config.debug_mode || Config.stats_mode - | Infer Driver -> true - | _ -> false +let should_setup_log_files (command : CLOpt.command) = match command with + | Analyze | Capture | Clang | Compile -> + Config.debug_mode || Config.stats_mode + | Run -> + true + | Report | ReportDiff -> + false -let create_outerr_log_files exe prefix_opt = +let create_outerr_log_files command prefix_opt = let lazy3 x = (lazy (fst3 (Lazy.force x)), lazy (snd3 (Lazy.force x)), lazy (trd3 (Lazy.force x))) in - if should_setup_log_files exe then + if should_setup_log_files command then let name_prefix = match prefix_opt with | Some name -> name ^ "-" | None -> "" in - (lazy (create_log_file exe name_prefix `Out) |> lazy3, - lazy (create_log_file exe name_prefix `Err) |> lazy3) + (lazy (create_log_file command name_prefix `Out) |> lazy3, + lazy (create_log_file command name_prefix `Err) |> lazy3) else stdout_err_log_files let ((out_formatter, out_chan, out_file), (err_formatter, err_chan, err_file)) = let (o_fmt, o_c, o_f), (e_fmt, e_c, e_f) = - create_outerr_log_files Config.parse_action None in + create_outerr_log_files Config.command None in ((ref o_fmt, ref o_c, ref o_f), (ref e_fmt, ref e_c, ref e_f)) -let set_log_file_identifier exe prefix_opt = - let (o_fmt, o_c, o_f), (e_fmt, e_c, e_f) = create_outerr_log_files exe prefix_opt in +let set_log_file_identifier command prefix_opt = + let (o_fmt, o_c, o_f), (e_fmt, e_c, e_f) = create_outerr_log_files command prefix_opt in (* close previous log files *) close_log_file !out_formatter !out_chan !out_file; close_log_file !err_formatter !err_chan !err_file; diff --git a/infer/src/base/Logging.mli b/infer/src/base/Logging.mli index 43745e06f..75376ee12 100644 --- a/infer/src/base/Logging.mli +++ b/infer/src/base/Logging.mli @@ -73,7 +73,7 @@ val set_delayed_prints : print_action list -> unit val reset_delayed_prints : unit -> unit (** Set a custom identifier to be part of the filename of the current logfiles. *) -val set_log_file_identifier : CommandLineOption.parse_action -> string option -> unit +val set_log_file_identifier : CommandLineOption.command -> string option -> unit (** print to the current out stream, as specified in set_log_file_identifier (note: only prints in debug or in stats mode) *) diff --git a/infer/src/clang/Capture.re b/infer/src/clang/Capture.re index 7ded700fd..413535829 100644 --- a/infer/src/clang/Capture.re +++ b/infer/src/clang/Capture.re @@ -49,7 +49,7 @@ let register_perf_stats_report source_file => { let init_global_state_for_capture_and_linters source_file => { Logging.set_log_file_identifier - CLOpt.(Infer Clang) (Some (Filename.basename (SourceFile.to_abs_path source_file))); + CLOpt.Clang (Some (Filename.basename (SourceFile.to_abs_path source_file))); register_perf_stats_report source_file; Config.curr_language := Config.Clang; DB.Results_dir.init source_file; @@ -165,7 +165,7 @@ let cc1_capture clang_cmd => { }; Logging.out "@\n*** Beginning capture of file %s ***@\n" source_path; if ( - Config.equal_analyzer Config.analyzer Config.Compile || + Config.equal_analyzer Config.analyzer Config.CompileOnly || CLocation.is_file_blacklisted source_path ) { Logging.out "@\n Skip the analysis of source file %s@\n@\n" source_path; @@ -179,7 +179,7 @@ let cc1_capture clang_cmd => { source_path (fun chan_in => run_and_validate_clang_frontend (`Pipe chan_in)) clang_cmd }; /* reset logging to stop capturing log output into the source file's log */ - Logging.set_log_file_identifier CLOpt.(Infer Clang) None; + Logging.set_log_file_identifier CLOpt.Capture None; () } }; diff --git a/infer/src/integration/Buck.ml b/infer/src/integration/Buck.ml index e579d83f1..9b6766d44 100644 --- a/infer/src/integration/Buck.ml +++ b/infer/src/integration/Buck.ml @@ -47,11 +47,11 @@ let add_flavor_to_target target = add "uber-compilation-database" | Some `NoDeps, _ -> add "compilation-database" - | None, Compile -> + | None, CompileOnly -> target - | None, (Linters | Capture) -> + | None, (Linters | CaptureOnly) -> add "infer-capture-all" - | None, (Checkers | Infer) -> + | None, (BiAbduction | Checkers) -> add "infer" | None, (Eradicate | Tracing | Crashcontext) -> failwithf "Analyzer %s is Java-only; not supported with Buck flavors" diff --git a/infer/src/integration/Javac.ml b/infer/src/integration/Javac.ml index 280bc6c11..57a2d10bd 100644 --- a/infer/src/integration/Javac.ml +++ b/infer/src/integration/Javac.ml @@ -81,6 +81,6 @@ let compile compiler build_prog build_args = let capture compiler ~prog ~args = let verbose_out_file = compile compiler prog args in - if Config.analyzer <> Config.Compile then + if Config.analyzer <> Config.CompileOnly then JMain.from_verbose_out verbose_out_file; if not (Config.debug_mode || Config.stats_mode) then Unix.unlink verbose_out_file diff --git a/infer/src/integration/Maven.ml b/infer/src/integration/Maven.ml index bf2818335..9883cce57 100644 --- a/infer/src/integration/Maven.ml +++ b/infer/src/integration/Maven.ml @@ -33,7 +33,7 @@ let infer_profile = lazy \n \ \n \ \n \ - " infer_profile_name (Config.(bin_dir ^/ string_of_analyzer Infer))) + " infer_profile_name (Config.(bin_dir ^/ infer_exe_name))) let pom_worklist = ref [CLOpt.init_work_dir] diff --git a/infer/src/unit/DifferentialFiltersTests.ml b/infer/src/unit/DifferentialFiltersTests.ml index 4056ec25d..a5d4140db 100644 --- a/infer/src/unit/DifferentialFiltersTests.ml +++ b/infer/src/unit/DifferentialFiltersTests.ml @@ -502,7 +502,7 @@ let test_resolve_infer_eradicate_conflict = (* [(test_name, analyzer, expected_hashes); ...] *) [ ("test_resolve_infer_eradicate_conflict_runs_with_infer_analyzer", - Config.Infer, + Config.BiAbduction, ([1], [11], [4])); ("test_resolve_infer_eradicate_conflict_skips_with_checkers_analyzer", Config.Checkers, diff --git a/opam b/opam index 83616c1d9..c8ed25034 100644 --- a/opam +++ b/opam @@ -28,6 +28,7 @@ ocaml-version: [ >= "4.04.0" ] depends: [ "ANSITerminal" {>="0.7"} "atdgen" {>="1.6.0"} + "cmdliner" {>="1.0.0"} "core" {<"v0.9"} "conf-autoconf" "ctypes" {>="0.9.2"} diff --git a/opam.lock b/opam.lock index 3c6cda43b..e08ce54be 100644 --- a/opam.lock +++ b/opam.lock @@ -6,6 +6,7 @@ biniou = 1.0.12 camlp4 = 4.04+1 camlzip = 1.07 camomile = 0.8.5 +cmdliner = 1.0.0 conf-autoconf = 0.1 conf-m4 = 1 conf-pkg-config = 1.0 diff --git a/scripts/toplevel_init b/scripts/toplevel_init index 1da040b14..ff5a83ec3 100644 --- a/scripts/toplevel_init +++ b/scripts/toplevel_init @@ -1,6 +1,7 @@ (* load dependencies *) #use "topfind";; #thread;; +#require "cmdliner";; #require "core.top";; #require "ctypes";; #require "ctypes.stubs";;