From 740e9973d6cb5d4cebe0d7179fcaf72a944cad5a Mon Sep 17 00:00:00 2001 From: Martino Luca Date: Thu, 7 Sep 2017 10:59:32 -0700 Subject: [PATCH] Replace existing calls to `exit` with InferExit exceptions to better control flow of executions Summary: With Logging.exit you have more control of the code that invokes exit, for example when forking and running certain functions that may in turn invoke exit, and you want to handle the execution flow differently - like invoking certain callbacks before exiting, or not exiting at all. Reviewed By: jvillard Differential Revision: D5746914 fbshipit-source-id: 596fba1 --- infer/src/backend/InferPrint.ml | 2 +- infer/src/backend/builtin.ml | 2 +- infer/src/backend/infer.ml | 4 ++-- infer/src/base/CommandLineOption.ml | 4 ++-- infer/src/base/Config.ml | 8 +++++--- infer/src/base/Die.ml | 6 ++++++ infer/src/base/Die.mli | 6 ++++++ infer/src/base/Epilogues.ml | 2 +- infer/src/base/Process.ml | 4 ++-- infer/src/base/ProcessPool.ml | 2 +- infer/src/clang/Capture.ml | 2 +- infer/src/clang/cTL.ml | 2 +- infer/src/clang_stubs/CTLParserHelper.ml | 3 ++- infer/src/integration/CaptureCompilationDatabase.ml | 2 +- infer/src/integration/Driver.ml | 2 +- infer/src/istd/IStd.ml | 6 ++++++ infer/src/scripts/checkCopyright.ml | 13 ++++++++----- 17 files changed, 47 insertions(+), 23 deletions(-) diff --git a/infer/src/backend/InferPrint.ml b/infer/src/backend/InferPrint.ml index 27ef7da86..20d47aa01 100644 --- a/infer/src/backend/InferPrint.ml +++ b/infer/src/backend/InferPrint.ml @@ -910,7 +910,7 @@ module AnalysisResults = struct if not (Filename.check_suffix arg Config.specs_files_suffix) && arg <> "." then print_usage_exit ("file " ^ arg ^ ": arguments must be .specs files")) Config.anon_args ; - if Config.test_filtering then ( Inferconfig.test () ; exit 0 ) ; + if Config.test_filtering then ( Inferconfig.test () ; L.exit 0 ) ; if List.is_empty Config.anon_args then load_specfiles () else List.rev Config.anon_args ) else load_specfiles () diff --git a/infer/src/backend/builtin.ml b/infer/src/backend/builtin.ml index dc184854f..7964d6299 100644 --- a/infer/src/backend/builtin.ml +++ b/infer/src/backend/builtin.ml @@ -61,4 +61,4 @@ let pp_registered fmt () = Format.fprintf fmt "@]@." (** print the builtin functions and exit *) -let print_and_exit () = pp_registered Format.std_formatter () ; exit 0 +let print_and_exit () = pp_registered Format.std_formatter () ; L.exit 0 diff --git a/infer/src/backend/infer.ml b/infer/src/backend/infer.ml index 85c96ac8a..41fb15d0e 100644 --- a/infer/src/backend/infer.ml +++ b/infer/src/backend/infer.ml @@ -80,9 +80,9 @@ let () = ( if Config.linters_validate_syntax_only then match CTLParserHelper.validate_al_files () with | Ok () - -> exit 0 + -> L.exit 0 | Error e - -> print_endline e ; exit 3 ) ; + -> print_endline e ; L.exit 3 ) ; if Config.print_builtins then Builtin.print_and_exit () ; setup_results_dir () ; if Config.debug_mode then L.progress "Logs in %s@." (Config.results_dir ^/ Config.log_file) ; diff --git a/infer/src/base/CommandLineOption.ml b/infer/src/base/CommandLineOption.ml index 74cb0199f..e942b77d0 100644 --- a/infer/src/base/CommandLineOption.ml +++ b/infer/src/base/CommandLineOption.ml @@ -674,7 +674,7 @@ let set_curr_speclist_for_parse_mode ~usage parse_mode = let curr_usage status = prerr_endline (String.concat_array ~sep:" " !args_to_parse) ; prerr_endline usage ; - exit status + Pervasives.exit status in (* "-help" and "--help" are automatically recognized by Arg.parse, so we have to give them special treatment *) @@ -883,7 +883,7 @@ let parse_args ~usage initial_action ?initial_command args = -> if !anon_arg_action.on_unknown <> `Reject && is_unknown usage_msg then ( anon_fun !args_to_parse.(!arg_being_parsed) ; parse_loop () ) - else ( Pervasives.prerr_string usage_msg ; exit 1 ) + else Pervasives.(prerr_string usage_msg ; exit 1) | Arg.Help _ -> (* we handle --help by ourselves and error on -help, so Arg has no way to raise Help anymore *) diff --git a/infer/src/base/Config.ml b/infer/src/base/Config.ml index 0f3353143..5cc6216f4 100644 --- a/infer/src/base/Config.ml +++ b/infer/src/base/Config.ml @@ -1789,10 +1789,10 @@ let post_parsing_initialization command_opt = -> CLOpt.show_manual ~internal_section:manual_internal !help_format CommandDoc.infer command_opt | `None -> () ) ; - if !version <> `None || !help <> `None then exit 0 ; + if !version <> `None || !help <> `None then Pervasives.exit 0 ; let uncaught_exception_handler exn raw_backtrace = let should_print_backtrace_default = - match exn with L.InferUserError _ -> false | _ -> true + match exn with L.InferUserError _ | L.InferExit _ -> false | _ -> true in let backtrace = Caml.Printexc.raw_backtrace_to_string raw_backtrace in let print_exception () = @@ -1810,6 +1810,8 @@ let post_parsing_initialization command_opt = -> error "Internal Error: " msg | L.InferUserError msg -> error "Usage Error: " msg + | L.InferExit _ + -> () | _ -> error "Uncaught error: " (Exn.to_string exn) in @@ -1819,7 +1821,7 @@ let post_parsing_initialization command_opt = Out_channel.newline stderr ; ANSITerminal.(prerr_string [Foreground Red] backtrace) ) ; print_exception () ; - exit (L.exit_code_of_exception exn) + Pervasives.exit (L.exit_code_of_exception exn) in Caml.Printexc.set_uncaught_exception_handler uncaught_exception_handler ; F.set_margin !margin ; diff --git a/infer/src/base/Die.ml b/infer/src/base/Die.ml index 380e460e1..8c65f0c28 100644 --- a/infer/src/base/Die.ml +++ b/infer/src/base/Die.ml @@ -17,6 +17,8 @@ exception InferInternalError of string exception InferUserError of string +exception InferExit of int + let raise_error error ~msg = match error with | ExternalError @@ -28,6 +30,8 @@ let raise_error error ~msg = let die error fmt = F.kasprintf (fun msg -> raise_error error ~msg) fmt +let exit exitcode = raise (InferExit exitcode) + let exit_code_of_exception = function | InferUserError _ -> 1 @@ -35,5 +39,7 @@ let exit_code_of_exception = function -> 3 | InferInternalError _ -> 4 + | InferExit exitcode + -> exitcode | _ -> (* exit code 2 is used by the OCaml runtime in cases of uncaught exceptions *) 2 diff --git a/infer/src/base/Die.mli b/infer/src/base/Die.mli index 476e2913d..a1b445c36 100644 --- a/infer/src/base/Die.mli +++ b/infer/src/base/Die.mli @@ -17,9 +17,15 @@ exception InferInternalError of string exception InferUserError of string +exception + InferExit of + int(** This can be used to avoid scattering exit invocations all over the codebase *) + (** kind of error for [die], with similar semantics as [Logging.{external,internal,user}_error] *) type error = ExternalError | InternalError | UserError +val exit : int -> 'a + val exit_code_of_exception : Exn.t -> int val die : error -> ('a, Format.formatter, unit, _) format4 -> 'a diff --git a/infer/src/base/Epilogues.ml b/infer/src/base/Epilogues.ml index 769b72fff..f01ac2905 100644 --- a/infer/src/base/Epilogues.ml +++ b/infer/src/base/Epilogues.ml @@ -17,7 +17,7 @@ let activate_run_epilogues_on_signal = F.eprintf "*** %s: Caught %s, time to die@." (Filename.basename Sys.executable_name) (Signal.to_string s) ; (* Epilogues are registered with [at_exit] so exiting will make them run. *) - exit 0 + Pervasives.exit 0 in Signal.Expert.handle Signal.int run_epilogues_on_signal) ) diff --git a/infer/src/base/Process.ml b/infer/src/base/Process.ml index 2fc66863b..beb943aa3 100644 --- a/infer/src/base/Process.ml +++ b/infer/src/base/Process.ml @@ -17,7 +17,7 @@ let print_error_and_exit ?(exit_code= 1) fmt = F.kfprintf (fun _ -> L.external_error "%s" (F.flush_str_formatter ()) ; - exit exit_code) + L.exit exit_code) F.str_formatter fmt (** Given a command to be executed, create a process to execute this command, and wait for it to @@ -45,7 +45,7 @@ let print_status ~fail_on_failed_job f pid status = L.progress ".%!" ; match status with | Error err when fail_on_failed_job - -> exit (match err with `Exit_non_zero i -> i | `Signal _ -> 1) + -> L.exit (match err with `Exit_non_zero i -> i | `Signal _ -> 1) | _ -> () diff --git a/infer/src/base/ProcessPool.ml b/infer/src/base/ProcessPool.ml index 5cd97b080..885355ea6 100644 --- a/infer/src/base/ProcessPool.ml +++ b/infer/src/base/ProcessPool.ml @@ -40,7 +40,7 @@ let start_child ~f ~pool x = | `In_the_child -> in_child := true ; f x ; - exit 0 + Pervasives.exit 0 | `In_the_parent _pid -> incr pool ; if should_wait pool then wait pool diff --git a/infer/src/clang/Capture.ml b/infer/src/clang/Capture.ml index 70e355d07..8d2d61d9a 100644 --- a/infer/src/clang/Capture.ml +++ b/infer/src/clang/Capture.ml @@ -110,7 +110,7 @@ let run_clang clang_command read = let exit_with_error exit_code = L.external_error "Error: the following clang command did not run successfully:@\n %s@\n" clang_command ; - exit exit_code + L.exit exit_code in (* NOTE: exceptions will propagate through without exiting here *) match Utils.with_process_in clang_command read with diff --git a/infer/src/clang/cTL.ml b/infer/src/clang/cTL.ml index 70712dd33..6e8319ef9 100644 --- a/infer/src/clang/cTL.ml +++ b/infer/src/clang/cTL.ml @@ -339,7 +339,7 @@ module Debug = struct L.progress "Press Enter to continue or type %s to quit... @?" quit_token ; match In_channel.input_line_exn In_channel.stdin |> String.lowercase with | s when String.equal s quit_token - -> exit 0 + -> L.exit 0 | _ -> (* Remove the line at the bottom of terminal with the debug instructions *) let open ANSITerminal in diff --git a/infer/src/clang_stubs/CTLParserHelper.ml b/infer/src/clang_stubs/CTLParserHelper.ml index 30a4f3fc5..c2ced96ad 100644 --- a/infer/src/clang_stubs/CTLParserHelper.ml +++ b/infer/src/clang_stubs/CTLParserHelper.ml @@ -7,4 +7,5 @@ * of patent rights can be found in the PATENTS file in the same directory. *) -let validate_al_files () = prerr_endline "ERROR: infer was built without clang support." ; exit 1 +let validate_al_files () = + prerr_endline "ERROR: infer was built without clang support." ; Die.exit 1 diff --git a/infer/src/integration/CaptureCompilationDatabase.ml b/infer/src/integration/CaptureCompilationDatabase.ml index 677dcab9f..6cac62851 100644 --- a/infer/src/integration/CaptureCompilationDatabase.ml +++ b/infer/src/integration/CaptureCompilationDatabase.ml @@ -97,7 +97,7 @@ let get_compilation_database_files_buck ~prog ~args = | Ok () -> match output with | [] - -> L.external_error "There are no files to process, exiting@." ; exit 0 + -> L.external_error "There are no files to process, exiting@." ; L.exit 0 | lines -> L.(debug Capture Quiet) "Reading compilation database from:@\n%s@\n" (String.concat ~sep:"\n" lines) ; diff --git a/infer/src/integration/Driver.ml b/infer/src/integration/Driver.ml index 8708a6ce5..5434aac91 100644 --- a/infer/src/integration/Driver.ml +++ b/infer/src/integration/Driver.ml @@ -457,7 +457,7 @@ let fail_on_issue_epilogue () = match Utils.read_file issues_json with | Ok lines -> let issues = Jsonbug_j.report_of_string @@ String.concat ~sep:"" lines in - if issues <> [] then exit Config.fail_on_issue_exit_code + if issues <> [] then L.exit Config.fail_on_issue_exit_code | Error error -> L.internal_error "Failed to read report file '%s': %s@." issues_json error ; () diff --git a/infer/src/istd/IStd.ml b/infer/src/istd/IStd.ml index 7ff37b4a1..d1f048c11 100644 --- a/infer/src/istd/IStd.ml +++ b/infer/src/istd/IStd.ml @@ -70,3 +70,9 @@ let failwithf _ : [`use_Logging_die_instead] = assert false let invalid_arg _ : [`use_Logging_die_instead] = assert false let invalid_argf _ : [`use_Logging_die_instead] = assert false + +(* With Logging.exit you have more control of the code that invokes exit, +for example when forking and running certain functions that may in turn invoke +exit, and you want to handle the execution flow differently - like invoking +certain callbacks before exiting, or not exiting at all. *) +let exit = `In_general_prefer_using_Logging_exit_over_Pervasives_exit diff --git a/infer/src/scripts/checkCopyright.ml b/infer/src/scripts/checkCopyright.ml index 62cba5dce..172362276 100644 --- a/infer/src/scripts/checkCopyright.ml +++ b/infer/src/scripts/checkCopyright.ml @@ -245,7 +245,7 @@ let check_copyright fname = let prefix = prefix_of_comment_style com_style in let start = default_start_line_of_com_style com_style in output_diff fname lines_arr start (-1) (-1) 0 false year com_style prefix ; - exit copyright_modified_exit_code + Pervasives.exit copyright_modified_exit_code | Some n -> let line = lines_arr.(n) in let cstart, com_style = find_comment_start_and_style lines_arr n in @@ -254,14 +254,17 @@ let check_copyright fname = let mono = contains_monoidics cstart cend lines_arr in match get_fb_year cstart cend lines_arr with | None - -> F.eprintf "Can't find fb year: %s@." fname ; exit copyright_malformed_exit_code + -> F.eprintf "Can't find fb year: %s@." fname ; + Pervasives.exit copyright_malformed_exit_code | Some fb_year -> let prefix = prefix_of_comment_style com_style in if copyright_has_changed mono fb_year com_style prefix cstart cend lines_arr then let len = String.length line in output_diff fname lines_arr cstart n cend len mono fb_year com_style prefix ; - exit copyright_modified_exit_code ) - else ( F.eprintf "Copyright not recognized: %s@." fname ; exit copyright_malformed_exit_code ) + Pervasives.exit copyright_modified_exit_code ) + else ( + F.eprintf "Copyright not recognized: %s@." fname ; + Pervasives.exit copyright_malformed_exit_code ) let speclist = [("-i", Arg.Set update_files, "Update copyright notice in-place")] @@ -272,4 +275,4 @@ let () = let add_file_to_check fname = to_check := fname :: !to_check in Arg.parse (Arg.align speclist) add_file_to_check usage_msg ; List.iter ~f:check_copyright (List.rev !to_check) ; - exit 0 + Pervasives.exit 0