From a0dfd699a8af471aee8a953a73f2b63cf34be70f Mon Sep 17 00:00:00 2001 From: Vladimir Silyaev Date: Thu, 11 Jan 2018 03:19:55 -0800 Subject: [PATCH] [infer][PR] Clean temporary files created by the clang frontend Summary: This commit augments codes to clean up temporary files generated by the clang frontend. Currently clang frontend leaves large number of temporary files int the tmp directory, and it could be seen for example by running these command: ``` git clean -xdf infer/models/ mkdir /tmp/infer env TMPDIR=/tmp/infer make infer_models ls -l /tmp/infer ``` P.S. Analyzing real project could easily cause each infer capture to leave hundreds of files in /tmp P.P.S. There are 11 total references to Filename.temp_file however, other 9 seems don't leak temporary files in such large scale (at least not when using the clang frontend). Closes https://github.com/facebook/infer/pull/816 Reviewed By: jvillard Differential Revision: D6385311 Pulled By: dulmarod fbshipit-source-id: f7956b0 --- infer/src/base/CommandLineOption.ml | 3 +++ infer/src/base/CommandLineOption.mli | 2 ++ infer/src/base/Config.ml | 12 +++--------- infer/src/base/Config.mli | 2 -- infer/src/base/Epilogues.ml | 13 +++++++++++-- infer/src/base/Epilogues.mli | 4 ++++ infer/src/base/ProcessPool.ml | 5 +---- infer/src/base/ProcessPool.mli | 2 -- infer/src/base/ProcessPoolState.ml | 10 ++++++++++ infer/src/base/ProcessPoolState.mli | 10 ++++++++++ infer/src/base/Utils.ml | 4 ++++ infer/src/base/Utils.mli | 3 +++ infer/src/integration/ClangQuotes.ml | 1 + 13 files changed, 52 insertions(+), 19 deletions(-) create mode 100644 infer/src/base/ProcessPoolState.ml create mode 100644 infer/src/base/ProcessPoolState.mli 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