[log] better exception reraising

Summary: Try to preserve the original backtrace. Introduce `reraise` in the global namespace.

Reviewed By: jberdine

Differential Revision: D5804121

fbshipit-source-id: 0947a47

configure.ac

@@ -182,7 +182,7 @@ fi
 AC_PROG_OCAML
 AC_ASSERT_PROG([ocamlc], [$OCAMLC])
 # check the version of OCaml
-AC_ASSERT_OCAML_MIN_VERSION([4.04.2])
+AC_ASSERT_OCAML_MIN_VERSION([4.05.0])
 AC_ASSERT_PROG([ocamlopt], [$OCAMLOPT])
 AC_CHECK_TOOL([OCAMLBUILD], [ocamlbuild], [no])
 AC_ASSERT_PROG([ocamlbuild], [$OCAMLBUILD])

infer/src/IR/Exceptions.ml

@@ -363,7 +363,8 @@ let recognize_exception exn =
         , None
         , Nocat )
     | exn
-     -> raise exn
+     -> L.internal_error "Backend error '%a'. Backtrace:@\n%s" Exn.pp exn (Exn.backtrace ()) ;
+        reraise exn
   in
   (err_name, desc, ml_loc_opt, visibility, severity, force_kind, eclass)
 

infer/src/backend/dom.ml

@@ -1567,7 +1567,7 @@ let sigma_partial_join tenv mode (sigma1: Prop.sigma) (sigma2: Prop.sigma)
   try
     if Rename.check lost_little then ( CheckJoin.final () ; (s1, s2, s3) )
     else ( L.d_strln "failed Rename.check" ; CheckJoin.final () ; raise Sil.JoinFail )
-  with exn -> CheckJoin.final () ; raise exn
+  with exn -> CheckJoin.final () ; reraise exn
 
 let rec sigma_partial_meet' tenv (sigma_acc: Prop.sigma) (sigma1_in: Prop.sigma)
     (sigma2_in: Prop.sigma) : Prop.sigma =
@@ -1812,7 +1812,7 @@ let prop_partial_meet tenv p1 p2 =
     Rename.final () ;
     FreshVarExp.final () ;
     Todo.final () ;
-    match exn with Sil.JoinFail -> None | _ -> raise exn
+    match exn with Sil.JoinFail -> None | _ -> reraise exn
 
 let eprop_partial_join' tenv mode (ep1: Prop.exposed Prop.t) (ep2: Prop.exposed Prop.t)
     : Prop.normal Prop.t =
@@ -1928,7 +1928,7 @@ let prop_partial_join pname tenv mode p1 p2 =
         FreshVarExp.final () ;
         Todo.final () ;
         if !Config.footprint then JoinState.set_footprint false ;
-        match exn with Sil.JoinFail -> None | _ -> raise exn )
+        match exn with Sil.JoinFail -> None | _ -> reraise exn )
   | Some _
    -> res_by_implication_only
 
@@ -1940,7 +1940,7 @@ let eprop_partial_join tenv mode (ep1: Prop.exposed Prop.t) (ep2: Prop.exposed P
   try
     let res = eprop_partial_join' tenv mode ep1 ep2 in
     Rename.final () ; FreshVarExp.final () ; Todo.final () ; res
-  with exn -> Rename.final () ; FreshVarExp.final () ; Todo.final () ; raise exn
+  with exn -> Rename.final () ; FreshVarExp.final () ; Todo.final () ; reraise exn
 
 (** {2 Join and Meet for Propset} *)
 

infer/src/backend/ondemand.ml

@@ -147,10 +147,10 @@ let run_proc_analysis analyze_proc curr_pdesc callee_pdesc =
     let final_summary = postprocess summary in
     restore_global_state old_state ; final_summary
   with exn ->
-    L.internal_error "@\nONDEMAND EXCEPTION %a %s@.@.BACK TRACE@.%s@?" Typ.Procname.pp callee_pname
-      (Exn.to_string exn) (Printexc.get_backtrace ()) ;
     restore_global_state old_state ;
-    if Config.keep_going then
+    if Config.keep_going then (
+      L.internal_error "@\nERROR RUNNING BACKEND: %a %s@\n@\nBACK TRACE@\n%s@?" Typ.Procname.pp
+        callee_pname (Exn.to_string exn) (Printexc.get_backtrace ()) ;
       match exn with
       | SymOp.Analysis_failure_exe kind
        -> (* in production mode, log the timeout/crash and continue with the summary we had before
@@ -158,8 +158,8 @@ let run_proc_analysis analyze_proc curr_pdesc callee_pdesc =
           log_error_and_continue exn initial_summary kind
       | _
        -> (* this happens with assert false or some other unrecognized exception *)
-          log_error_and_continue exn initial_summary (FKcrash (Exn.to_string exn))
+          log_error_and_continue exn initial_summary (FKcrash (Exn.to_string exn)) )
-    else raise exn
+    else reraise exn
 
 let analyze_proc_desc curr_pdesc callee_pdesc : Specs.summary option =
   let callee_pname = Procdesc.get_proc_name callee_pdesc in
@@ -167,7 +167,7 @@ let analyze_proc_desc curr_pdesc callee_pdesc : Specs.summary option =
   match !callbacks_ref with
   | None
    -> L.(die InternalError)
-        "No callbacks registered to analyze proc desc %a when analyzing %a@." Typ.Procname.pp
+        "No callbacks registered to analyze proc desc %a when analyzing %a" Typ.Procname.pp
         callee_pname Typ.Procname.pp (Procdesc.get_proc_name curr_pdesc)
   | Some callbacks
    -> if should_be_analyzed callee_pname proc_attributes then

infer/src/backend/prop.ml

@@ -448,7 +448,7 @@ let atom_const_lt_exp (atom: Sil.atom) =
 
 let exp_reorder e1 e2 = if Exp.compare e1 e2 <= 0 then (e1, e2) else (e2, e1)
 
-(** create a strexp of the given type, populating the structures if [expand_structs] is true *)
+(** create a strexp of the given type, populating the structures if [struct_init_mode] is [Fld_init] *)
 let rec create_strexp_of_type tenv struct_init_mode (typ: Typ.t) len inst : Sil.strexp =
   let init_value () =
     let create_fresh_var () =
@@ -1364,10 +1364,9 @@ module Normalize = struct
     let nsexp = strexp_normalize tenv Sil.sub_empty sexp in
     Hpointsto (lexp, nsexp, te)
 
-  (** Construct a points-to predicate for an expression using
+  (** Construct a points-to predicate for an expression using either the provided expression [name]
-      either the provided expression [name] as
+      as base for fresh identifiers. If [struct_init_mode] is [Fld_init], initialize the fields of
-      base for fresh identifiers. If [expand_structs] is true,
+      structs with fresh variables. *)
-      initialize the fields of structs with fresh variables. *)
   let mk_ptsto_exp tenv struct_init_mode (exp, (te: Exp.t), expo) inst : Sil.hpred =
     let default_strexp () : Sil.strexp =
       match te with
@@ -1754,7 +1753,7 @@ let mk_dll_hpara tenv iF oB oF svars evars body =
   Normalize.hpara_dll_normalize tenv para
 
 (** Construct a points-to predicate for a single program variable.
-    If [expand_structs] is true, initialize the fields of structs with fresh variables. *)
+    If [expand_structs] is [Fld_init], initialize the fields of structs with fresh variables. *)
 let mk_ptsto_lvar tenv expand_structs inst ((pvar: Pvar.t), texp, expo) : Sil.hpred =
   Normalize.mk_ptsto_exp tenv expand_structs (Lvar pvar, texp, expo) inst
 

infer/src/backend/prover.ml

@@ -17,7 +17,7 @@ module F = Format
 
 let decrease_indent_when_exception thunk =
   try thunk ()
-  with exn when SymOp.exn_not_failure exn -> L.d_decrease_indent 1 ; raise exn
+  with exn when SymOp.exn_not_failure exn -> L.d_decrease_indent 1 ; reraise exn
 
 let compute_max_from_nonempty_int_list l = uw (List.max_elt ~cmp:IntLit.compare_value l)
 

infer/src/backend/symExec.ml

@@ -1633,7 +1633,7 @@ and check_variadic_sentinel ?(fails_on_nil= false) n_formals (sentinel, null_pos
             loc
         in
         raise (Exceptions.Premature_nil_termination (err_desc, __POS__))
-      else raise e
+      else reraise e
   in
   (* fold_left reverses the arguments back so that we report an *)
   (* error on the first premature nil argument *)

infer/src/backend/timeout.ml

@@ -106,4 +106,4 @@ let exe_timeout f x =
       Errdesc.warning_err (State.get_loc ()) "TIMEOUT: %a@." SymOp.pp_failure_kind kind ;
       Some kind
   | exe
-   -> resume_previous_timeout () ; raise exe
+   -> resume_previous_timeout () ; reraise exe

infer/src/base/Config.ml

@@ -2396,7 +2396,7 @@ let set_reference_and_call_function reference value f x =
     reference := value ;
     let res = f x in
     restore () ; res
-  with exn -> restore () ; raise exn
+  with exn -> restore () ; reraise exn
 
 (** Current Objective-C Automatic Reference Counting (ARC) mode *)
 let arc_mode = ref false

infer/src/base/Config.mli

@@ -658,10 +658,6 @@ val xml_specs : bool
 
 (** Global variables *)
 
-val set_reference_and_call_function : 'a ref -> 'a -> ('b -> 'c) -> 'b -> 'c
-(** [set_reference_and_call_function ref val f x] calls f x with ref set to val.
-    Restore the initial value also in case of exception. *)
-
 val arc_mode : bool ref
 
 val curr_language : language ref

infer/src/base/SymOp.ml

@@ -28,18 +28,20 @@ let try_finally ?(fail_early= false) f g =
   | r
    -> g () ; r
   | exception (Analysis_failure_exe _ as f_exn)
-   -> ( if not fail_early then
+   -> let backtrace = Caml.Printexc.get_raw_backtrace () in
+      ( if not fail_early then
           try g ()
-          with _ -> () ) ;
+          with _ -> () (* swallow in favor of the original exception *) ) ;
-      raise f_exn
+      reraise ~backtrace f_exn
-  | exception f_exn ->
+  | exception f_exn
+   -> let f_backtrace = Caml.Printexc.get_raw_backtrace () in
       match g () with
       | ()
-     -> raise f_exn
+       -> reraise ~backtrace:f_backtrace f_exn
       | exception (Analysis_failure_exe _ as g_exn)
-     -> raise g_exn
+       -> reraise g_exn
       | exception _
-     -> raise f_exn
+       -> reraise ~backtrace:f_backtrace f_exn
 
 let finally_try g f = try_finally f g
 

infer/src/base/Utils.ml

@@ -169,8 +169,10 @@ let do_finally f g =
   let res =
     try f ()
     with exc ->
-      g () |> ignore ;
+      let backtrace = Caml.Printexc.get_raw_backtrace () in
-      raise exc
+      ( try g () |> ignore
+        with _ -> () (* swallow in favor of the original exception *) ) ;
+      reraise ~backtrace exc
   in
   let res' = g () in
   (res, res')

infer/src/clang/Capture.ml

@@ -104,11 +104,14 @@ let run_clang_frontend ast_source =
 
 let run_and_validate_clang_frontend ast_source =
   try run_clang_frontend ast_source
-  with exc -> if not Config.keep_going then raise exc
+  with exc ->
+    if not Config.keep_going then reraise exc
+    else
+      L.internal_error "ERROR RUNNING CAPTURE: %a@\n%s@\n" Exn.pp exc (Printexc.get_backtrace ())
 
 let run_clang clang_command read =
   let exit_with_error exit_code =
-    L.external_error "Error: the following clang command did not run successfully:@\n  %s@\n"
+    L.external_error "Error: the following clang command did not run successfully:@\n  %s@\n%!"
       clang_command ;
     L.exit exit_code
   in

infer/src/clang/cFrontend_checkers_main.ml

@@ -333,4 +333,4 @@ let do_frontend_checks (trans_unit_ctx: CFrontend_config.translation_unit_contex
     (* NOTE: Assumes that an AST always starts with a TranslationUnitDecl *)
   with Assert_failure (file, line, column) as exn ->
     L.internal_error "Fatal error: exception Assert_failure(%s, %d, %d)@\n%!" file line column ;
-    raise exn
+    reraise exn

infer/src/integration/Javac.ml

@@ -73,7 +73,7 @@ let compile compiler build_prog build_args =
             "@\n*** Failed to execute compilation command: %s@\n*** Command: %s@\n*** Output:@\n%s%s@\n*** Infer needs a working compilation command to run.@."
             (Unix.Exit_or_signal.to_string_hum (Error err)) shell_cmd log verbose_errlog
       | None, `ExceptionError exn
-       -> raise exn
+       -> reraise exn
     in
     match Utils.with_process_in shell_cmd_redirected In_channel.input_all with
     | log, Error err

infer/src/integration/Maven.ml

@@ -131,9 +131,8 @@ let add_infer_profile mvn_pom infer_pom =
     protect ~f:with_ic ~finally:(fun () -> In_channel.close ic)
   in
   try Utils.with_file_out infer_pom ~f:with_oc
-  with Xmlm.Error ((line, col), error) as exn ->
+  with Xmlm.Error ((line, col), error) ->
-    L.external_error "%s:%d:%d: ERROR: %s@." mvn_pom line col (Xmlm.error_message error) ;
+    L.die ExternalError "%s:%d:%d: ERROR: %s" mvn_pom line col (Xmlm.error_message error)
-    raise exn
 
 let add_profile_to_pom_in_directory dir =
   (* Even though there is a "-f" command-line arguments to change the config file Maven reads from,

infer/src/istd/IStd.ml

@@ -63,6 +63,12 @@ module PVariant = struct
   let ( = ) (v1: [> ]) (v2: [> ]) = Polymorphic_compare.( = ) v1 v2
 end
 
+let reraise ?backtrace:backtrace0 exn =
+  let backtrace =
+    match backtrace0 with Some bt -> bt | None -> Caml.Printexc.get_raw_backtrace ()
+  in
+  Caml.Printexc.raise_with_backtrace exn backtrace
+
 let failwith _ : [`use_Logging_die_instead] = assert false
 
 let failwithf _ : [`use_Logging_die_instead] = assert false
@@ -71,8 +77,7 @@ let invalid_arg _ : [`use_Logging_die_instead] = assert false
 
 let invalid_argf _ : [`use_Logging_die_instead] = assert false
 
-(* With Logging.exit you have more control of the code that invokes exit,
+(** With Logging.exit you have more control of the code that invokes exit, for example when forking
-for example when forking and running certain functions that may in turn invoke
+    and running certain functions that may in turn invoke exit, and you want to handle the execution
-exit, and you want to handle the execution flow differently - like invoking
+    flow differently - like invoking certain callbacks before exiting, or not exiting at all. *)
-certain callbacks before exiting, or not exiting at all. *)
 let exit = `In_general_prefer_using_Logging_exit_over_Pervasives_exit

infer/src/java/jFrontend.ml

@@ -202,7 +202,7 @@ let compute_source_icfg linereader classes program tenv source_basename package_
     {JContext.cg= Cg.create source_file; JContext.cfg= Cfg.create_cfg (); JContext.tenv= tenv}
   in
   let select test procedure cn node =
-    if test node then try procedure cn node with Bir.Subroutine -> () | e -> raise e
+    if test node then try procedure cn node with Bir.Subroutine -> () | e -> reraise e
   in
   let () =
     JBasics.ClassMap.iter
@@ -220,5 +220,5 @@ let compute_class_icfg source_file linereader program tenv node =
   | Bir.Subroutine
    -> ()
   | e
-   -> raise e ) ;
+   -> reraise e ) ;
   (icfg.JContext.cg, icfg.JContext.cfg)