Permalink
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...
ljw1004 authored and hhvm-bot committed Oct 9, 2018
1 parent e784381 commit ba14fef7fe4f89105266d04478876ae6eaf14904
@@ -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

0 comments on commit ba14fef

Please sign in to comment.