diff --git a/infer/src/backend/infer.ml b/infer/src/backend/infer.ml index 86c2abc1e..ebcb504a0 100644 --- a/infer/src/backend/infer.ml +++ b/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 diff --git a/infer/src/base/Config.ml b/infer/src/base/Config.ml index c4effedb4..002c4abf9 100644 --- a/infer/src/base/Config.ml +++ b/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 ; diff --git a/infer/src/base/Config.mli b/infer/src/base/Config.mli index 0c67c52ce..dee6575f6 100644 --- a/infer/src/base/Config.mli +++ b/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 diff --git a/infer/src/base/Epilogues.ml b/infer/src/base/Epilogues.ml index 0a8d70059..acebf78d3 100644 --- a/infer/src/base/Epilogues.ml +++ b/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 - diff --git a/infer/src/base/ResultsDatabase.ml b/infer/src/base/ResultsDatabase.ml index f530d281e..8b7d759a4 100644 --- a/infer/src/base/ResultsDatabase.ml +++ b/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