diff --git a/infer/src/base/CommandLineOption.ml b/infer/src/base/CommandLineOption.ml index fdf616760..06fcbee56 100644 --- a/infer/src/base/CommandLineOption.ml +++ b/infer/src/base/CommandLineOption.ml @@ -965,6 +965,8 @@ let parse_args ~usage initial_action ?initial_command args = parse_loop () ; curr_usage +let keep_args_file = ref false + let parse ?config_file ~usage action initial_command = let env_args = decode_env_to_argv (Option.value (Sys.getenv args_env_var) ~default:"") in let inferconfig_args = @@ -1008,6 +1010,7 @@ let parse ?config_file ~usage action initial_command = to prevent this from happening *) let file = Filename.temp_file "args_" "" in Out_channel.with_file file ~f:(fun oc -> Out_channel.output_lines oc argv_to_export) ; + if not !keep_args_file then Utils.unlink_file_on_exit file ; "@" ^ file else "" in diff --git a/infer/src/base/CommandLineOption.mli b/infer/src/base/CommandLineOption.mli index 025605e49..2ffac7759 100644 --- a/infer/src/base/CommandLineOption.mli +++ b/infer/src/base/CommandLineOption.mli @@ -249,3 +249,5 @@ val show_manual : (** Display the manual of [command] to the user, or [command_doc] if [command] is None. [format] is used as for [Cmdliner.Manpage.print]. If [internal_section] is specified, add a section titled [internal_section] about internal (hidden) options. *) + +val keep_args_file : bool ref diff --git a/infer/src/base/Config.ml b/infer/src/base/Config.ml index 7463a724a..f4288a9c3 100644 --- a/infer/src/base/Config.ml +++ b/infer/src/base/Config.ml @@ -1057,6 +1057,7 @@ and ( bo_debug "Debug mode (also sets $(b,--debug-level 2), $(b,--developer-mode), $(b,--no-filtering), $(b,--print-buckets), $(b,--print-types), $(b,--reports-include-ml-loc), $(b,--no-only-cheap-debug), $(b,--trace-error), $(b,--write-dotty), $(b,--write-html))" ~f:(fun debug -> if debug then set_debug_level 2 else set_debug_level 0 ; + CommandLineOption.keep_args_file := debug ; debug ) [ developer_mode ; print_buckets @@ -2055,14 +2056,7 @@ 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 register_late_epilogue = Epilogues.register_late let post_parsing_initialization command_opt = if CommandLineOption.is_originator then @@ -2160,7 +2154,7 @@ let post_parsing_initialization command_opt = Out_channel.newline stderr ) ; let exitcode = L.exit_code_of_exception exn in L.log_uncaught_exception exn ~exitcode ; - late_epilogue () ; + Epilogues.late () ; Pervasives.exit exitcode 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 536c4b4b2..4ed21e38f 100644 --- a/infer/src/base/Config.mli +++ b/infer/src/base/Config.mli @@ -741,5 +741,3 @@ 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 acebf78d3..b4672dd23 100644 --- a/infer/src/base/Epilogues.ml +++ b/infer/src/base/Epilogues.ml @@ -9,6 +9,15 @@ open! IStd module F = Format +let late_callback = ref (fun () -> ()) + +let register_late f = + let g = !late_callback in + late_callback := fun () -> f () ; g () + + +let late () = !late_callback () + (* Run the epilogues when we get SIGINT (Control-C). We do not want to mask SIGINT unless at least one epilogue has been registered, so make this value lazy. *) let activate_run_epilogues_on_signal = @@ -18,7 +27,7 @@ let activate_run_epilogues_on_signal = (Filename.basename Sys.executable_name) (Signal.to_string s) ; (* Invoke the callback that runs at the end of uncaught_exception_handler *) - Config.late_epilogue () ; + late () ; (* Epilogues are registered with [at_exit] so exiting will make them run. *) Pervasives.exit 0 in @@ -27,7 +36,7 @@ let activate_run_epilogues_on_signal = let register ~f desc = let f_no_exn () = - if not !ProcessPool.in_child then + if not !ProcessPoolState.in_child then try f () with exn -> F.eprintf "Error while running epilogue \"%s\":@ %a.@ Powering through...@." desc Exn.pp exn diff --git a/infer/src/base/Epilogues.mli b/infer/src/base/Epilogues.mli index f964a5547..073dcb9d7 100644 --- a/infer/src/base/Epilogues.mli +++ b/infer/src/base/Epilogues.mli @@ -12,3 +12,7 @@ open! IStd val register : f:(unit -> unit) -> string -> unit (** Register a function to run when the program exits or is interrupted. Registered functions are run in the reverse order in which they were registered. *) + +val register_late : (unit -> unit) -> unit + +val late : unit -> unit diff --git a/infer/src/base/ProcessPool.ml b/infer/src/base/ProcessPool.ml index d9ec1191a..a2d02bf3d 100644 --- a/infer/src/base/ProcessPool.ml +++ b/infer/src/base/ProcessPool.ml @@ -8,9 +8,6 @@ *) open! IStd -(** Keep track of whether the current execution is in a child process *) -let in_child = ref false - type t = {mutable num_processes: int; jobs: int} exception Execution_error of string @@ -39,7 +36,7 @@ let should_wait counter = counter.num_processes >= counter.jobs let start_child ~f ~pool x = match Unix.fork () with | `In_the_child -> - in_child := true ; + ProcessPoolState.in_child := true ; f x ; Pervasives.exit 0 | `In_the_parent _pid -> diff --git a/infer/src/base/ProcessPool.mli b/infer/src/base/ProcessPool.mli index 11920a519..7ee3b72ad 100644 --- a/infer/src/base/ProcessPool.mli +++ b/infer/src/base/ProcessPool.mli @@ -24,5 +24,3 @@ val start_child : f:('a -> unit) -> pool:t -> 'a -> unit val wait_all : t -> unit (** Wait until all the currently executing processes terminate *) -val in_child : bool ref -(** Keep track of whether the current execution is in a child process *) diff --git a/infer/src/base/ProcessPoolState.ml b/infer/src/base/ProcessPoolState.ml new file mode 100644 index 000000000..e64cc4755 --- /dev/null +++ b/infer/src/base/ProcessPoolState.ml @@ -0,0 +1,10 @@ +(* + * Copyright (c) 2018 - present Facebook, Inc. + * All rights reserved. + * + * This source code is licensed under the BSD style license found in the + * LICENSE file in the root directory of this source tree. An additional grant + * of patent rights can be found in the PATENTS file in the same directory. + *) +(** Keep track of whether the current execution is in a child process *) +let in_child = ref false diff --git a/infer/src/base/ProcessPoolState.mli b/infer/src/base/ProcessPoolState.mli new file mode 100644 index 000000000..27ed17975 --- /dev/null +++ b/infer/src/base/ProcessPoolState.mli @@ -0,0 +1,10 @@ +(* + * Copyright (c) 2018 - present Facebook, Inc. + * All rights reserved. + * + * This source code is licensed under the BSD style license found in the + * LICENSE file in the root directory of this source tree. An additional grant + * of patent rights can be found in the PATENTS file in the same directory. + *) +val in_child : bool ref +(** Keep track of whether the current execution is in a child process *) diff --git a/infer/src/base/Utils.ml b/infer/src/base/Utils.ml index 32bf7def8..d4c6966bd 100644 --- a/infer/src/base/Utils.ml +++ b/infer/src/base/Utils.ml @@ -391,3 +391,7 @@ let yield () = let better_hash x = Marshal.to_string x [Marshal.No_sharing] |> Caml.Digest.string + +let unlink_file_on_exit temp_file = + "Cleaning temporary file " ^ temp_file + |> Epilogues.register ~f:(fun () -> try Unix.unlink temp_file with _ -> ()) diff --git a/infer/src/base/Utils.mli b/infer/src/base/Utils.mli index 6634dba8d..788abc7b5 100644 --- a/infer/src/base/Utils.mli +++ b/infer/src/base/Utils.mli @@ -113,3 +113,6 @@ val yield : unit -> unit val better_hash : 'a -> Caml.Digest.t (** Hashtbl.hash only hashes the first 10 meaningful values, [better_hash] uses everything. *) + +val unlink_file_on_exit : string -> unit +(** delete [temporary] file on exit *) diff --git a/infer/src/integration/ClangQuotes.ml b/infer/src/integration/ClangQuotes.ml index cdec7af3c..5e0cb667a 100644 --- a/infer/src/integration/ClangQuotes.ml +++ b/infer/src/integration/ClangQuotes.ml @@ -37,4 +37,5 @@ let mk_arg_file prefix style args = in Utils.with_file_out file ~f:write_args |> ignore ; L.(debug Capture Medium) "Clang options stored in file %s@\n" file ; + if not Config.debug_mode then Utils.unlink_file_on_exit file ; file