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
master
Martino Luca 7 years ago committed by Facebook Github Bot
parent e247492901
commit 740e9973d6

@ -910,7 +910,7 @@ module AnalysisResults = struct
if not (Filename.check_suffix arg Config.specs_files_suffix) && arg <> "." then if not (Filename.check_suffix arg Config.specs_files_suffix) && arg <> "." then
print_usage_exit ("file " ^ arg ^ ": arguments must be .specs files")) print_usage_exit ("file " ^ arg ^ ": arguments must be .specs files"))
Config.anon_args ; 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 ) if List.is_empty Config.anon_args then load_specfiles () else List.rev Config.anon_args )
else load_specfiles () else load_specfiles ()

@ -61,4 +61,4 @@ let pp_registered fmt () =
Format.fprintf fmt "@]@." Format.fprintf fmt "@]@."
(** print the builtin functions and exit *) (** 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

@ -80,9 +80,9 @@ let () =
( if Config.linters_validate_syntax_only then ( if Config.linters_validate_syntax_only then
match CTLParserHelper.validate_al_files () with match CTLParserHelper.validate_al_files () with
| Ok () | Ok ()
-> exit 0 -> L.exit 0
| Error e | Error e
-> print_endline e ; exit 3 ) ; -> print_endline e ; L.exit 3 ) ;
if Config.print_builtins then Builtin.print_and_exit () ; if Config.print_builtins then Builtin.print_and_exit () ;
setup_results_dir () ; setup_results_dir () ;
if Config.debug_mode then L.progress "Logs in %s@." (Config.results_dir ^/ Config.log_file) ; if Config.debug_mode then L.progress "Logs in %s@." (Config.results_dir ^/ Config.log_file) ;

@ -674,7 +674,7 @@ let set_curr_speclist_for_parse_mode ~usage parse_mode =
let curr_usage status = let curr_usage status =
prerr_endline (String.concat_array ~sep:" " !args_to_parse) ; prerr_endline (String.concat_array ~sep:" " !args_to_parse) ;
prerr_endline usage ; prerr_endline usage ;
exit status Pervasives.exit status
in in
(* "-help" and "--help" are automatically recognized by Arg.parse, so we have to give them special (* "-help" and "--help" are automatically recognized by Arg.parse, so we have to give them special
treatment *) treatment *)
@ -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 ( -> if !anon_arg_action.on_unknown <> `Reject && is_unknown usage_msg then (
anon_fun !args_to_parse.(!arg_being_parsed) ; anon_fun !args_to_parse.(!arg_being_parsed) ;
parse_loop () ) parse_loop () )
else ( Pervasives.prerr_string usage_msg ; exit 1 ) else Pervasives.(prerr_string usage_msg ; exit 1)
| Arg.Help _ | Arg.Help _
-> (* we handle --help by ourselves and error on -help, so Arg has no way to raise Help -> (* we handle --help by ourselves and error on -help, so Arg has no way to raise Help
anymore *) anymore *)

@ -1789,10 +1789,10 @@ let post_parsing_initialization command_opt =
-> CLOpt.show_manual ~internal_section:manual_internal !help_format CommandDoc.infer command_opt -> CLOpt.show_manual ~internal_section:manual_internal !help_format CommandDoc.infer command_opt
| `None | `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 uncaught_exception_handler exn raw_backtrace =
let should_print_backtrace_default = let should_print_backtrace_default =
match exn with L.InferUserError _ -> false | _ -> true match exn with L.InferUserError _ | L.InferExit _ -> false | _ -> true
in in
let backtrace = Caml.Printexc.raw_backtrace_to_string raw_backtrace in let backtrace = Caml.Printexc.raw_backtrace_to_string raw_backtrace in
let print_exception () = let print_exception () =
@ -1810,6 +1810,8 @@ let post_parsing_initialization command_opt =
-> error "Internal Error: " msg -> error "Internal Error: " msg
| L.InferUserError msg | L.InferUserError msg
-> error "Usage Error: " msg -> error "Usage Error: " msg
| L.InferExit _
-> ()
| _ | _
-> error "Uncaught error: " (Exn.to_string exn) -> error "Uncaught error: " (Exn.to_string exn)
in in
@ -1819,7 +1821,7 @@ let post_parsing_initialization command_opt =
Out_channel.newline stderr ; Out_channel.newline stderr ;
ANSITerminal.(prerr_string [Foreground Red] backtrace) ) ; ANSITerminal.(prerr_string [Foreground Red] backtrace) ) ;
print_exception () ; print_exception () ;
exit (L.exit_code_of_exception exn) Pervasives.exit (L.exit_code_of_exception exn)
in in
Caml.Printexc.set_uncaught_exception_handler uncaught_exception_handler ; Caml.Printexc.set_uncaught_exception_handler uncaught_exception_handler ;
F.set_margin !margin ; F.set_margin !margin ;

@ -17,6 +17,8 @@ exception InferInternalError of string
exception InferUserError of string exception InferUserError of string
exception InferExit of int
let raise_error error ~msg = let raise_error error ~msg =
match error with match error with
| ExternalError | ExternalError
@ -28,6 +30,8 @@ let raise_error error ~msg =
let die error fmt = F.kasprintf (fun msg -> raise_error error ~msg) fmt 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 let exit_code_of_exception = function
| InferUserError _ | InferUserError _
-> 1 -> 1
@ -35,5 +39,7 @@ let exit_code_of_exception = function
-> 3 -> 3
| InferInternalError _ | InferInternalError _
-> 4 -> 4
| InferExit exitcode
-> exitcode
| _ | _
-> (* exit code 2 is used by the OCaml runtime in cases of uncaught exceptions *) 2 -> (* exit code 2 is used by the OCaml runtime in cases of uncaught exceptions *) 2

@ -17,9 +17,15 @@ exception InferInternalError of string
exception InferUserError 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] *) (** kind of error for [die], with similar semantics as [Logging.{external,internal,user}_error] *)
type error = ExternalError | InternalError | UserError type error = ExternalError | InternalError | UserError
val exit : int -> 'a
val exit_code_of_exception : Exn.t -> int val exit_code_of_exception : Exn.t -> int
val die : error -> ('a, Format.formatter, unit, _) format4 -> 'a val die : error -> ('a, Format.formatter, unit, _) format4 -> 'a

@ -17,7 +17,7 @@ let activate_run_epilogues_on_signal =
F.eprintf "*** %s: Caught %s, time to die@." (Filename.basename Sys.executable_name) F.eprintf "*** %s: Caught %s, time to die@." (Filename.basename Sys.executable_name)
(Signal.to_string s) ; (Signal.to_string s) ;
(* Epilogues are registered with [at_exit] so exiting will make them run. *) (* Epilogues are registered with [at_exit] so exiting will make them run. *)
exit 0 Pervasives.exit 0
in in
Signal.Expert.handle Signal.int run_epilogues_on_signal) ) Signal.Expert.handle Signal.int run_epilogues_on_signal) )

@ -17,7 +17,7 @@ let print_error_and_exit ?(exit_code= 1) fmt =
F.kfprintf F.kfprintf
(fun _ -> (fun _ ->
L.external_error "%s" (F.flush_str_formatter ()) ; L.external_error "%s" (F.flush_str_formatter ()) ;
exit exit_code) L.exit exit_code)
F.str_formatter fmt F.str_formatter fmt
(** Given a command to be executed, create a process to execute this command, and wait for it to (** 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 ".%!" ; L.progress ".%!" ;
match status with match status with
| Error err when fail_on_failed_job | 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)
| _ | _
-> () -> ()

@ -40,7 +40,7 @@ let start_child ~f ~pool x =
| `In_the_child | `In_the_child
-> in_child := true ; -> in_child := true ;
f x ; f x ;
exit 0 Pervasives.exit 0
| `In_the_parent _pid | `In_the_parent _pid
-> incr pool ; -> incr pool ;
if should_wait pool then wait pool if should_wait pool then wait pool

@ -110,7 +110,7 @@ let run_clang clang_command read =
let exit_with_error exit_code = let exit_with_error exit_code =
L.external_error "Error: the following clang command did not run successfully:@\n %s@\n" L.external_error "Error: the following clang command did not run successfully:@\n %s@\n"
clang_command ; clang_command ;
exit exit_code L.exit exit_code
in in
(* NOTE: exceptions will propagate through without exiting here *) (* NOTE: exceptions will propagate through without exiting here *)
match Utils.with_process_in clang_command read with match Utils.with_process_in clang_command read with

@ -339,7 +339,7 @@ module Debug = struct
L.progress "Press Enter to continue or type %s to quit... @?" quit_token ; 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 match In_channel.input_line_exn In_channel.stdin |> String.lowercase with
| s when String.equal s quit_token | s when String.equal s quit_token
-> exit 0 -> L.exit 0
| _ | _
-> (* Remove the line at the bottom of terminal with the debug instructions *) -> (* Remove the line at the bottom of terminal with the debug instructions *)
let open ANSITerminal in let open ANSITerminal in

@ -7,4 +7,5 @@
* of patent rights can be found in the PATENTS file in the same directory. * 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

@ -97,7 +97,7 @@ let get_compilation_database_files_buck ~prog ~args =
| Ok () -> | Ok () ->
match output with 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 | lines
-> L.(debug Capture Quiet) -> L.(debug Capture Quiet)
"Reading compilation database from:@\n%s@\n" (String.concat ~sep:"\n" lines) ; "Reading compilation database from:@\n%s@\n" (String.concat ~sep:"\n" lines) ;

@ -457,7 +457,7 @@ let fail_on_issue_epilogue () =
match Utils.read_file issues_json with match Utils.read_file issues_json with
| Ok lines | Ok lines
-> let issues = Jsonbug_j.report_of_string @@ String.concat ~sep:"" lines in -> 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 | Error error
-> L.internal_error "Failed to read report file '%s': %s@." issues_json error ; () -> L.internal_error "Failed to read report file '%s': %s@." issues_json error ; ()

@ -70,3 +70,9 @@ let failwithf _ : [`use_Logging_die_instead] = assert false
let invalid_arg _ : [`use_Logging_die_instead] = assert false let invalid_arg _ : [`use_Logging_die_instead] = assert false
let invalid_argf _ : [`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

@ -245,7 +245,7 @@ let check_copyright fname =
let prefix = prefix_of_comment_style com_style in let prefix = prefix_of_comment_style com_style in
let start = default_start_line_of_com_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 ; 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 | Some n
-> let line = lines_arr.(n) in -> let line = lines_arr.(n) in
let cstart, com_style = find_comment_start_and_style 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 let mono = contains_monoidics cstart cend lines_arr in
match get_fb_year cstart cend lines_arr with match get_fb_year cstart cend lines_arr with
| None | 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 | Some fb_year
-> let prefix = prefix_of_comment_style com_style in -> let prefix = prefix_of_comment_style com_style in
if copyright_has_changed mono fb_year com_style prefix cstart cend lines_arr then if copyright_has_changed mono fb_year com_style prefix cstart cend lines_arr then
let len = String.length line in let len = String.length line in
output_diff fname lines_arr cstart n cend len mono fb_year com_style prefix ; output_diff fname lines_arr cstart n cend len mono fb_year com_style prefix ;
exit copyright_modified_exit_code ) Pervasives.exit copyright_modified_exit_code )
else ( F.eprintf "Copyright not recognized: %s@." fname ; exit copyright_malformed_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")] 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 let add_file_to_check fname = to_check := fname :: !to_check in
Arg.parse (Arg.align speclist) add_file_to_check usage_msg ; Arg.parse (Arg.align speclist) add_file_to_check usage_msg ;
List.iter ~f:check_copyright (List.rev !to_check) ; List.iter ~f:check_copyright (List.rev !to_check) ;
exit 0 Pervasives.exit 0

Loading…
Cancel
Save