Permalink
This commit does not belong to any branch on this repository, and may belong to a fork outside of the repository.
Browse files
tighten up Printexc.get_backtrace 6
Summary:
This diff tightens up Printexc.backtrace in the last place that called Hh_logger.exc_with_dodgy_backtrace. I think the Core_utils.try_with function has a design that makes safe callstacks impossible. I have therefore changed us to use Utils.try_with_stack, which preserves the callstack at moment of catching exception.
(I'd have liked to mark Core_result.try_with as DEPRECATED, but I dont want to alter something that comes from Core).
Reviewed By: arxanas
Differential Revision: D10162683
fbshipit-source-id: 2abe28764005fa36602e1f52f9d3d20b8f76b4e7
Loading branch information
@@ -177,9 +177,9 @@ let save_state
update_save_state ~file_info_on_disk files_info errors output_filename
let get_in_memory_dep_table_entry_count () : (int, string) result =
Core_result. try_with (fun () ->
Utils. try_with_stack (fun () ->
SharedMem. get_in_memory_dep_table_entry_count () )
|> Core_result. map_error ~f: Printexc. to_string
|> Core_result. map_error ~f: ( fun ( exn , _stack ) -> Printexc. to_string exn )
(* If successful, returns the # of edges from the dependency table that were written. *)
(* TODO: write some other stats, e.g., the number of names, the number of errors, etc. *)
@@ -188,6 +188,6 @@ let go
(files_info : FileInfo.t Relative_path.Map.t )
(errors : Errors.t )
(output_filename : string ) : (int, string) result =
Core_result. try_with (fun () ->
Utils. try_with_stack (fun () ->
save_state ~file_info_on_disk files_info errors output_filename)
|> Core_result. map_error ~f: Printexc. to_string
|> Core_result. map_error ~f: ( fun ( exn , _stack ) -> Printexc. to_string exn )
@@ -51,8 +51,8 @@ let connect_to_monitor ~timeout root =
MC. connect_once ~timeout (hh_monitor_config root)
let print_hash_stats () =
Core_result. try_with SharedMem. dep_stats
|> Core_result. map_error ~f: Hh_logger. exc_with_dodgy_backtrace
Utils. try_with_stack SharedMem. dep_stats
|> Core_result. map_error ~f: ( fun ( exn , Utils. Callstack stack ) -> Hh_logger. exc ~stack exn )
|> Core_result. iter ~f: begin fun { SharedMem.
used_slots;
slots;
@@ -61,8 +61,8 @@ let print_hash_stats () =
Hh_logger. log " Dependency table load factor: %d / %d (%.02f)"
used_slots slots load_factor
end;
Core_result. try_with SharedMem. hash_stats
|> Core_result. map_error ~f: Hh_logger. exc_with_dodgy_backtrace
Utils. try_with_stack SharedMem. hash_stats
|> Core_result. map_error ~f: ( fun ( exn , Utils. Callstack stack ) -> Hh_logger. exc ~stack exn )
|> Core_result. iter ~f: begin fun { SharedMem.
used_slots;
slots;
@@ -38,12 +38,6 @@ let print_duration name t =
print_with_newline " %s: %f" name (t2 -. t);
t2
let exc_with_dodgy_backtrace ?(prefix : string = "" ) (e : exn ) : unit =
(* TODO - delete this function and use call normal Hh_logger functions with ~exn *)
print_with_newline " %s%s" prefix (Printexc. to_string e);
Printexc. print_backtrace stderr;
()
let exc ?(prefix : string = "" ) ~(stack : string ) (e : exn ) : unit =
print_with_newline " %s%s\n %s" prefix (Printexc. to_string e) stack
@@ -9,6 +9,9 @@
open Hh_core
(* * Callstack is simply a typed way to indicate that a string is a callstack *)
type callstack = Callstack of string
let () = Random. self_init ()
let debug = ref false
let profile = ref false
@@ -110,7 +113,7 @@ let is_prefix_dir dir fn =
String. length fn > String. length prefix &&
String. sub fn 0 (String. length prefix) = prefix
let try_with_channel oc f1 f2 =
let try_with_channel ( oc : out_channel ) ( f1 : out_channel -> 'a ) ( f2 : exn -> 'a ) : 'a =
try
let result = f1 oc in
close_out oc;
@@ -119,6 +122,14 @@ let try_with_channel oc f1 f2 =
close_out oc;
f2 e
let try_with_stack (f : unit -> 'a ) : ('a, exn * callstack) result =
try
Ok (f () )
with exn ->
let stack = Callstack (Printexc. get_backtrace () ) in
Error (exn , stack)
let iter_n_acc n f acc =
let acc = ref acc in
for i = 1 to n-1 do
@@ -212,9 +223,6 @@ let infimum (arr : 'a array)
end in
binary_search 0 ((Array. length arr) - 1 )
(* * Callstack is simply a typed way to indicate that a string is a callstack *)
type callstack = Callstack of string
let unwrap_snd (a , b_opt ) =
match b_opt with
| None -> None
Toggle all file notes
Toggle all file annotations