Add `late_epilogue` callback that gets invoked at the end of infer's lifecycle

Summary:
This is a good moment to close Sqlite's DB handles, and in general can be used to postpone some actions right before infer terminates.
Since exiting is done via uncaught exception handling, the `late_epilogue` callback will run at the very end, even after all the `at_exit` callbacks have been invoked. The only exception is made in case of signalling, in which case the `late_epilogue` is still invoked, but before any of the `at_exit` callbacks.

Reviewed By: jvillard

Differential Revision: D6404961

fbshipit-source-id: 8ff7a05

infer/src/backend/infer.ml

@@ -84,7 +84,7 @@ let () =
   log_environment_info () ;
   if Config.debug_mode && CLOpt.is_originator then
     L.progress "Logs in %s@." (Config.results_dir ^/ Config.log_file) ;
-  match Config.command with
+  ( match Config.command with
   | Analyze ->
       let pp_cluster_opt fmt = function
         | None ->
@@ -126,4 +126,5 @@ let () =
       if is_error (Unix.waitpid (Unix.fork_exec ~prog ~argv:(prog :: args) ())) then
         L.external_error
           "** Error running the reporting script:@\n**   %s %s@\n** See error above@." prog
-          (String.concat ~sep:" " args)
+          (String.concat ~sep:" " args) ) ;
+  L.exit 0

infer/src/base/Config.ml

@@ -2053,6 +2053,15 @@ let inferconfig_file =
       find (Sys.getcwd ()) |> Option.map ~f:(fun dir -> dir ^/ CommandDoc.inferconfig_file)
 
 
+let late_epilogue_callback = ref (fun () -> ())
+
+let register_late_epilogue f =
+  let g = !late_epilogue_callback in
+  late_epilogue_callback := fun () -> f () ; g ()
+
+
+let late_epilogue () = !late_epilogue_callback ()
+
 let post_parsing_initialization command_opt =
   if CommandLineOption.is_originator then
     Unix.putenv ~key:infer_top_results_dir_env_var ~data:!results_dir ;
@@ -2108,11 +2117,14 @@ let post_parsing_initialization command_opt =
       () ) ;
   if !version <> `None || !help <> `None then Pervasives.exit 0 ;
   let uncaught_exception_handler exn raw_backtrace =
+    let is_infer_exit_zero = match exn with L.InferExit 0 -> true | _ -> false in
     let should_print_backtrace_default =
       match exn with L.InferUserError _ | L.InferExit _ -> false | _ -> true
     in
     let suggest_keep_going = should_print_backtrace_default && not !keep_going in
-    let backtrace = Caml.Printexc.raw_backtrace_to_string raw_backtrace in
+    let backtrace =
+      if is_infer_exit_zero then "" else Caml.Printexc.raw_backtrace_to_string raw_backtrace
+    in
     let print_exception () =
       let error prefix msg =
         ANSITerminal.(prerr_string [Bold; Foreground Red]) prefix ;
@@ -2133,17 +2145,18 @@ let post_parsing_initialization command_opt =
       | _ ->
           error "Uncaught error: " (Exn.to_string exn)
     in
-    if should_print_backtrace_default || !developer_mode then (
+    if not is_infer_exit_zero && (should_print_backtrace_default || !developer_mode) then (
       Out_channel.newline stderr ;
       ANSITerminal.(prerr_string [Foreground Red]) "Error backtrace:" ;
       Out_channel.newline stderr ;
       ANSITerminal.(prerr_string [Foreground Red]) backtrace ) ;
     print_exception () ;
-    Out_channel.newline stderr ;
+    if not is_infer_exit_zero then Out_channel.newline stderr ;
     if suggest_keep_going then (
       ANSITerminal.(prerr_string [])
         "Run the command again with `--keep-going` to try and ignore this error." ;
       Out_channel.newline stderr ) ;
+    late_epilogue () ;
     Pervasives.exit (L.exit_code_of_exception exn)
   in
   Caml.Printexc.set_uncaught_exception_handler uncaught_exception_handler ;

infer/src/base/Config.mli

@@ -733,3 +733,9 @@ val clang_compilation_dbs : [`Escaped of string | `Raw of string] list ref
 (** Command Line Interface Documentation *)
 
 val print_usage_exit : unit -> 'a
+
+(** Miscellanous *)
+
+val register_late_epilogue : (unit -> unit) -> unit
+
+val late_epilogue : unit -> unit

infer/src/base/Epilogues.ml

@@ -17,6 +17,8 @@ let activate_run_epilogues_on_signal =
        F.eprintf "*** %s: Caught %s, time to die@."
          (Filename.basename Sys.executable_name)
          (Signal.to_string s) ;
+       (* Invoke the callback that runs at the end of uncaught_exception_handler *)
+       Config.late_epilogue () ;
        (* Epilogues are registered with [at_exit] so exiting will make them run. *)
        Pervasives.exit 0
      in
@@ -34,4 +36,3 @@ let register ~f desc =
   Pervasives.at_exit f_no_exn ;
   (* Register signal masking. *)
   Lazy.force activate_run_epilogues_on_signal
-

infer/src/base/ResultsDatabase.ml

@@ -118,3 +118,5 @@ let new_database_connection () =
   database := Some db ;
   List.iter ~f:(fun callback -> callback db) !new_db_callbacks
 
+
+let () = Config.register_late_epilogue db_close