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

@@ -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 ()
 

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

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) ;

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 *)

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 ;

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

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

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) )
 

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)
   | _
    -> ()
 

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

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

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

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

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) ;

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 ; ()
 

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

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