[exceptions] make more efforts to preserve backtraces

Summary:
Calling functions that raise exceptions (even if they get caught) may smudge
the backtraces we get from OCaml. We need to record the original backtrace
*before* calling such fuctions on the path between catching an exception and
reraising it.

Also change the heptuple returned by `Exceptions.recognize_exception` into a
record type, and make that function not raise when classifying exceptions.

Reviewed By: jberdine

Differential Revision: D5882934

fbshipit-source-id: 8e99fe8

infer/src/IR/Errlog.ml

@@ -217,25 +217,24 @@ let update errlog_old errlog_new =
   ErrLogHash.iter (fun err_key l -> ignore (add_issue errlog_old err_key l)) errlog_new
 
 let log_issue err_kind err_log loc (node_id, node_key) session ltr ?linters_def_file ?doc_url exn =
-  let err_name, err_desc, ml_loc_opt, visibility, severity, force_kind, eclass =
+  let error = Exceptions.recognize_exception exn in
-    Exceptions.recognize_exception exn
+  let err_kind = match error.kind with Some err_kind -> err_kind | _ -> err_kind in
-  in
-  let err_kind = match force_kind with Some err_kind -> err_kind | _ -> err_kind in
   let hide_java_loc_zero =
     (* hide java errors at location zero unless in -developer_mode *)
     not Config.developer_mode && Config.curr_language_is Config.Java
     && Int.equal loc.Location.line 0
   in
   let hide_memory_error =
-    match Localise.error_desc_get_bucket err_desc with
+    match Localise.error_desc_get_bucket error.description with
     | Some bucket when String.equal bucket Mleak_buckets.ml_bucket_unknown_origin
      -> not Mleak_buckets.should_raise_leak_unknown_origin
     | _
      -> false
   in
   let log_it =
-    Exceptions.equal_visibility visibility Exceptions.Exn_user
+    Exceptions.equal_visibility error.visibility Exceptions.Exn_user
-    || Config.developer_mode && Exceptions.equal_visibility visibility Exceptions.Exn_developer
+    || Config.developer_mode
+       && Exceptions.equal_visibility error.visibility Exceptions.Exn_developer
   in
   if log_it && not hide_java_loc_zero && not hide_memory_error then
     let added =
@@ -244,31 +243,32 @@ let log_issue err_kind err_log loc (node_id, node_key) session ltr ?linters_def_
         { node_id_key
         ; session
         ; loc
-        ; loc_in_ml_source= ml_loc_opt
+        ; loc_in_ml_source= error.ml_loc
         ; loc_trace= ltr
-        ; err_class= eclass
+        ; err_class= error.category
-        ; visibility
+        ; visibility= error.visibility
         ; linters_def_file
         ; doc_url }
       in
       let err_key =
         { err_kind
         ; in_footprint= !Config.footprint
-        ; err_name
+        ; err_name= error.name
-        ; err_desc
+        ; err_desc= error.description
-        ; severity= severity_to_str severity }
+        ; severity= severity_to_str error.severity }
       in
       add_issue err_log err_key (ErrDataSet.singleton err_data)
     in
     let should_print_now = match exn with Exceptions.Internal_error _ -> true | _ -> added in
     let print_now () =
-      let ex_name, desc, ml_loc_opt, _, _, _, _ = Exceptions.recognize_exception exn in
       L.(debug Analysis Medium)
-        "@\n%a@\n@?" (Exceptions.pp_err ~node_key loc err_kind ex_name desc ml_loc_opt) () ;
+        "@\n%a@\n@?"
+        (Exceptions.pp_err ~node_key loc err_kind error.name error.description error.ml_loc) () ;
       if err_kind <> Exceptions.Kerror then
         let warn_str =
           let pp fmt =
-            Format.fprintf fmt "%s %a" err_name.IssueType.unique_id Localise.pp_error_desc desc
+            Format.fprintf fmt "%s %a" error.name.IssueType.unique_id Localise.pp_error_desc
+              error.description
           in
           F.asprintf "%t" pp
         in

infer/src/IR/Exceptions.ml

@@ -149,233 +149,518 @@ exception Use_after_free of Localise.error_desc * L.ml_loc
 
 exception Wrong_argument_number of L.ml_loc
 
-(** Turn an exception into a descriptive string, error description, location in ml source, and category *)
+type t =
+  { name: IssueType.t
+  ; description: Localise.error_desc
+  ; ml_loc: Logging.ml_loc option  (** location in the infer source code *)
+  ; visibility: visibility
+  ; severity: severity
+  ; kind: err_kind option
+  ; category: err_class }
+
 let recognize_exception exn =
-  let err_name, desc, (ml_loc_opt: L.ml_loc option), visibility, severity, force_kind, eclass =
+  match exn with
-    match exn with
+  (* all the static names of errors must be defined in Config.IssueType *)
-    (* all the static names of errors must be defined in Config.IssueType *)
+  | Abduction_case_not_implemented ml_loc
-    | Abduction_case_not_implemented ml_loc
+   -> { name= IssueType.abduction_case_not_implemented
-     -> ( IssueType.abduction_case_not_implemented
+      ; description= Localise.no_desc
-        , Localise.no_desc
+      ; ml_loc= Some ml_loc
-        , Some ml_loc
+      ; visibility= Exn_developer
-        , Exn_developer
+      ; severity= Low
-        , Low
+      ; kind= None
-        , None
+      ; category= Nocat }
-        , Nocat )
+  | Context_leak (desc, _)
-    | Context_leak (desc, _)
+   -> { name= IssueType.context_leak
-     -> (IssueType.context_leak, desc, None, Exn_user, High, None, Nocat)
+      ; description= desc
-    | Analysis_stops (desc, ml_loc_opt)
+      ; ml_loc= None
-     -> let visibility = if Config.analysis_stops then Exn_user else Exn_developer in
+      ; visibility= Exn_user
-        (IssueType.analysis_stops, desc, ml_loc_opt, visibility, Medium, None, Nocat)
+      ; severity= High
-    | Array_of_pointsto ml_loc
+      ; kind= None
-     -> ( IssueType.array_of_pointsto
+      ; category= Nocat }
-        , Localise.no_desc
+  | Analysis_stops (desc, ml_loc_opt)
-        , Some ml_loc
+   -> let visibility = if Config.analysis_stops then Exn_user else Exn_developer in
-        , Exn_developer
+      { name= IssueType.analysis_stops
-        , Low
+      ; description= desc
-        , None
+      ; ml_loc= ml_loc_opt
-        , Nocat )
+      ; visibility
-    | Array_out_of_bounds_l1 (desc, ml_loc)
+      ; severity= Medium
-     -> (IssueType.array_out_of_bounds_l1, desc, Some ml_loc, Exn_user, High, Some Kerror, Checker)
+      ; kind= None
-    | Array_out_of_bounds_l2 (desc, ml_loc)
+      ; category= Nocat }
-     -> (IssueType.array_out_of_bounds_l2, desc, Some ml_loc, Exn_user, Medium, None, Nocat)
+  | Array_of_pointsto ml_loc
-    | Array_out_of_bounds_l3 (desc, ml_loc)
+   -> { name= IssueType.array_of_pointsto
-     -> (IssueType.array_out_of_bounds_l3, desc, Some ml_loc, Exn_developer, Medium, None, Nocat)
+      ; description= Localise.no_desc
-    | Assert_failure (f, l, c)
+      ; ml_loc= Some ml_loc
-     -> let ml_loc = (f, l, c, c) in
+      ; visibility= Exn_developer
-        (IssueType.assert_failure, Localise.no_desc, Some ml_loc, Exn_developer, High, None, Nocat)
+      ; severity= Low
-    | Bad_footprint ml_loc
+      ; kind= None
-     -> (IssueType.bad_footprint, Localise.no_desc, Some ml_loc, Exn_developer, Low, None, Nocat)
+      ; category= Nocat }
-    | Cannot_star ml_loc
+  | Array_out_of_bounds_l1 (desc, ml_loc)
-     -> (IssueType.cannot_star, Localise.no_desc, Some ml_loc, Exn_developer, Low, None, Nocat)
+   -> { name= IssueType.array_out_of_bounds_l1
-    | Class_cast_exception (desc, ml_loc)
+      ; description= desc
-     -> (IssueType.class_cast_exception, desc, Some ml_loc, Exn_user, High, None, Prover)
+      ; ml_loc= Some ml_loc
-    | Codequery desc
+      ; visibility= Exn_user
-     -> (IssueType.codequery, desc, None, Exn_user, High, None, Prover)
+      ; severity= High
-    | Comparing_floats_for_equality (desc, ml_loc)
+      ; kind= Some Kerror
-     -> (IssueType.comparing_floats_for_equality, desc, Some ml_loc, Exn_user, Medium, None, Nocat)
+      ; category= Checker }
-    | Condition_always_true_false (desc, b, ml_loc)
+  | Array_out_of_bounds_l2 (desc, ml_loc)
-     -> let name =
+   -> { name= IssueType.array_out_of_bounds_l2
-          if b then IssueType.condition_always_true else IssueType.condition_always_false
+      ; description= desc
-        in
+      ; ml_loc= Some ml_loc
-        (name, desc, Some ml_loc, Exn_user, Medium, None, Nocat)
+      ; visibility= Exn_user
-    | Custom_error (error_msg, desc)
+      ; severity= Medium
-     -> (IssueType.from_string error_msg, desc, None, Exn_user, High, None, Checker)
+      ; kind= None
-    | Dangling_pointer_dereference (dko, desc, ml_loc)
+      ; category= Nocat }
-     -> let visibility =
+  | Array_out_of_bounds_l3 (desc, ml_loc)
-          match dko with
+   -> { name= IssueType.array_out_of_bounds_l3
-          | Some _
+      ; description= desc
-           -> Exn_user (* only show to the user if the category was identified *)
+      ; ml_loc= Some ml_loc
-          | None
+      ; visibility= Exn_developer
-           -> Exn_developer
+      ; severity= Medium
+      ; kind= None
+      ; category= Nocat }
+  | Assert_failure (f, l, c)
+   -> let ml_loc = (f, l, c, c) in
+      { name= IssueType.assert_failure
+      ; description= Localise.no_desc
+      ; ml_loc= Some ml_loc
+      ; visibility= Exn_developer
+      ; severity= High
+      ; kind= None
+      ; category= Nocat }
+  | Bad_footprint ml_loc
+   -> { name= IssueType.bad_footprint
+      ; description= Localise.no_desc
+      ; ml_loc= Some ml_loc
+      ; visibility= Exn_developer
+      ; severity= Low
+      ; kind= None
+      ; category= Nocat }
+  | Cannot_star ml_loc
+   -> { name= IssueType.cannot_star
+      ; description= Localise.no_desc
+      ; ml_loc= Some ml_loc
+      ; visibility= Exn_developer
+      ; severity= Low
+      ; kind= None
+      ; category= Nocat }
+  | Class_cast_exception (desc, ml_loc)
+   -> { name= IssueType.class_cast_exception
+      ; description= desc
+      ; ml_loc= Some ml_loc
+      ; visibility= Exn_user
+      ; severity= High
+      ; kind= None
+      ; category= Prover }
+  | Codequery desc
+   -> { name= IssueType.codequery
+      ; description= desc
+      ; ml_loc= None
+      ; visibility= Exn_user
+      ; severity= High
+      ; kind= None
+      ; category= Prover }
+  | Comparing_floats_for_equality (desc, ml_loc)
+   -> { name= IssueType.comparing_floats_for_equality
+      ; description= desc
+      ; ml_loc= Some ml_loc
+      ; visibility= Exn_user
+      ; severity= Medium
+      ; kind= None
+      ; category= Nocat }
+  | Condition_always_true_false (desc, b, ml_loc)
+   -> let name = if b then IssueType.condition_always_true else IssueType.condition_always_false in
+      { name
+      ; description= desc
+      ; ml_loc= Some ml_loc
+      ; visibility= Exn_user
+      ; severity= Medium
+      ; kind= None
+      ; category= Nocat }
+  | Custom_error (error_msg, desc)
+   -> { name= IssueType.from_string error_msg
+      ; description= desc
+      ; ml_loc= None
+      ; visibility= Exn_user
+      ; severity= High
+      ; kind= None
+      ; category= Checker }
+  | Dangling_pointer_dereference (dko, desc, ml_loc)
+   -> let visibility =
+        match dko with
+        | Some _
+         -> Exn_user (* only show to the user if the category was identified *)
+        | None
+         -> Exn_developer
+      in
+      { name= IssueType.dangling_pointer_dereference
+      ; description= desc
+      ; ml_loc= Some ml_loc
+      ; visibility
+      ; severity= High
+      ; kind= None
+      ; category= Prover }
+  | Deallocate_stack_variable desc
+   -> { name= IssueType.deallocate_stack_variable
+      ; description= desc
+      ; ml_loc= None
+      ; visibility= Exn_user
+      ; severity= High
+      ; kind= None
+      ; category= Prover }
+  | Deallocate_static_memory desc
+   -> { name= IssueType.deallocate_static_memory
+      ; description= desc
+      ; ml_loc= None
+      ; visibility= Exn_user
+      ; severity= High
+      ; kind= None
+      ; category= Prover }
+  | Deallocation_mismatch (desc, ml_loc)
+   -> { name= IssueType.deallocation_mismatch
+      ; description= desc
+      ; ml_loc= Some ml_loc
+      ; visibility= Exn_user
+      ; severity= High
+      ; kind= None
+      ; category= Prover }
+  | Divide_by_zero (desc, ml_loc)
+   -> { name= IssueType.divide_by_zero
+      ; description= desc
+      ; ml_loc= Some ml_loc
+      ; visibility= Exn_user
+      ; severity= High
+      ; kind= Some Kerror
+      ; category= Checker }
+  | Double_lock (desc, ml_loc)
+   -> { name= IssueType.double_lock
+      ; description= desc
+      ; ml_loc= Some ml_loc
+      ; visibility= Exn_user
+      ; severity= High
+      ; kind= Some Kerror
+      ; category= Prover }
+  | Eradicate (kind_s, desc)
+   -> { name= IssueType.from_string kind_s
+      ; description= desc
+      ; ml_loc= None
+      ; visibility= Exn_user
+      ; severity= High
+      ; kind= None
+      ; category= Prover }
+  | Empty_vector_access (desc, ml_loc)
+   -> { name= IssueType.empty_vector_access
+      ; description= desc
+      ; ml_loc= Some ml_loc
+      ; visibility= Exn_user
+      ; severity= High
+      ; kind= Some Kerror
+      ; category= Prover }
+  | Field_not_null_checked (desc, ml_loc)
+   -> { name= IssueType.field_not_null_checked
+      ; description= desc
+      ; ml_loc= Some ml_loc
+      ; visibility= Exn_user
+      ; severity= Medium
+      ; kind= Some Kwarning
+      ; category= Nocat }
+  | Frontend_warning ((name, hum), desc, ml_loc)
+   -> { name= IssueType.from_string name ?hum
+      ; description= desc
+      ; ml_loc= Some ml_loc
+      ; visibility= Exn_user
+      ; severity= Medium
+      ; kind= None
+      ; category= Linters }
+  | Checkers (kind_s, desc)
+   -> { name= IssueType.from_string kind_s
+      ; description= desc
+      ; ml_loc= None
+      ; visibility= Exn_user
+      ; severity= High
+      ; kind= None
+      ; category= Prover }
+  | Null_dereference (desc, ml_loc)
+   -> { name= IssueType.null_dereference
+      ; description= desc
+      ; ml_loc= Some ml_loc
+      ; visibility= Exn_user
+      ; severity= High
+      ; kind= None
+      ; category= Prover }
+  | Null_test_after_dereference (desc, ml_loc)
+   -> { name= IssueType.null_test_after_dereference
+      ; description= desc
+      ; ml_loc= Some ml_loc
+      ; visibility= Exn_user
+      ; severity= High
+      ; kind= None
+      ; category= Nocat }
+  | Pointer_size_mismatch (desc, ml_loc)
+   -> { name= IssueType.pointer_size_mismatch
+      ; description= desc
+      ; ml_loc= Some ml_loc
+      ; visibility= Exn_user
+      ; severity= High
+      ; kind= Some Kerror
+      ; category= Checker }
+  | Inherently_dangerous_function desc
+   -> { name= IssueType.inherently_dangerous_function
+      ; description= desc
+      ; ml_loc= None
+      ; visibility= Exn_developer
+      ; severity= Medium
+      ; kind= None
+      ; category= Nocat }
+  | Internal_error desc
+   -> { name= IssueType.internal_error
+      ; description= desc
+      ; ml_loc= None
+      ; visibility= Exn_developer
+      ; severity= High
+      ; kind= None
+      ; category= Nocat }
+  | Java_runtime_exception (exn_name, _, desc)
+   -> let exn_str = Typ.Name.name exn_name in
+      { name= IssueType.from_string exn_str
+      ; description= desc
+      ; ml_loc= None
+      ; visibility= Exn_user
+      ; severity= High
+      ; kind= None
+      ; category= Prover }
+  | Leak (fp_part, _, (exn_vis, error_desc), done_array_abstraction, resource, ml_loc)
+   -> if done_array_abstraction then
+        { name= IssueType.leak_after_array_abstraction
+        ; description= error_desc
+        ; ml_loc= Some ml_loc
+        ; visibility= Exn_developer
+        ; severity= High
+        ; kind= None
+        ; category= Prover }
+      else if fp_part then
+        { name= IssueType.leak_in_footprint
+        ; description= error_desc
+        ; ml_loc= Some ml_loc
+        ; visibility= Exn_developer
+        ; severity= High
+        ; kind= None
+        ; category= Prover }
+      else
+        let name =
+          match resource with
+          | PredSymb.Rmemory _
+           -> IssueType.memory_leak
+          | PredSymb.Rfile
+           -> IssueType.resource_leak
+          | PredSymb.Rlock
+           -> IssueType.resource_leak
+          | PredSymb.Rignore
+           -> IssueType.memory_leak
         in
-        (IssueType.dangling_pointer_dereference, desc, Some ml_loc, visibility, High, None, Prover)
+        { name
-    | Deallocate_stack_variable desc
+        ; description= error_desc
-     -> (IssueType.deallocate_stack_variable, desc, None, Exn_user, High, None, Prover)
+        ; ml_loc= Some ml_loc
-    | Deallocate_static_memory desc
+        ; visibility= exn_vis
-     -> (IssueType.deallocate_static_memory, desc, None, Exn_user, High, None, Prover)
+        ; severity= High
-    | Deallocation_mismatch (desc, ml_loc)
+        ; kind= None
-     -> (IssueType.deallocation_mismatch, desc, Some ml_loc, Exn_user, High, None, Prover)
+        ; category= Prover }
-    | Divide_by_zero (desc, ml_loc)
+  | Missing_fld (fld, ml_loc)
-     -> (IssueType.divide_by_zero, desc, Some ml_loc, Exn_user, High, Some Kerror, Checker)
+   -> let desc = Localise.verbatim_desc (Typ.Fieldname.to_full_string fld) in
-    | Double_lock (desc, ml_loc)
+      { name= IssueType.missing_fld
-     -> (IssueType.double_lock, desc, Some ml_loc, Exn_user, High, Some Kerror, Prover)
+      ; description= desc
-    | Eradicate (kind_s, desc)
+      ; ml_loc= Some ml_loc
-     -> (IssueType.from_string kind_s, desc, None, Exn_user, High, None, Prover)
+      ; visibility= Exn_developer
-    | Empty_vector_access (desc, ml_loc)
+      ; severity= Medium
-     -> (IssueType.empty_vector_access, desc, Some ml_loc, Exn_user, High, Some Kerror, Prover)
+      ; kind= None
-    | Field_not_null_checked (desc, ml_loc)
+      ; category= Nocat }
-     -> ( IssueType.field_not_null_checked
+  | Premature_nil_termination (desc, ml_loc)
-        , desc
+   -> { name= IssueType.premature_nil_termination
-        , Some ml_loc
+      ; description= desc
-        , Exn_user
+      ; ml_loc= Some ml_loc
-        , Medium
+      ; visibility= Exn_user
-        , Some Kwarning
+      ; severity= High
-        , Nocat )
+      ; kind= None
-    | Frontend_warning ((name, hum), desc, ml_loc)
+      ; category= Prover }
-     -> (IssueType.from_string name ?hum, desc, Some ml_loc, Exn_user, Medium, None, Linters)
+  | Parameter_not_null_checked (desc, ml_loc)
-    | Checkers (kind_s, desc)
+   -> { name= IssueType.parameter_not_null_checked
-     -> (IssueType.from_string kind_s, desc, None, Exn_user, High, None, Prover)
+      ; description= desc
-    | Null_dereference (desc, ml_loc)
+      ; ml_loc= Some ml_loc
-     -> (IssueType.null_dereference, desc, Some ml_loc, Exn_user, High, None, Prover)
+      ; visibility= Exn_user
-    | Null_test_after_dereference (desc, ml_loc)
+      ; severity= Medium
-     -> (IssueType.null_test_after_dereference, desc, Some ml_loc, Exn_user, High, None, Nocat)
+      ; kind= Some Kwarning
-    | Pointer_size_mismatch (desc, ml_loc)
+      ; category= Nocat }
-     -> (IssueType.pointer_size_mismatch, desc, Some ml_loc, Exn_user, High, Some Kerror, Checker)
+  | Precondition_not_found (desc, ml_loc)
-    | Inherently_dangerous_function desc
+   -> { name= IssueType.precondition_not_found
-     -> (IssueType.inherently_dangerous_function, desc, None, Exn_developer, Medium, None, Nocat)
+      ; description= desc
-    | Internal_error desc
+      ; ml_loc= Some ml_loc
-     -> (IssueType.internal_error, desc, None, Exn_developer, High, None, Nocat)
+      ; visibility= Exn_developer
-    | Java_runtime_exception (exn_name, _, desc)
+      ; severity= Low
-     -> let exn_str = Typ.Name.name exn_name in
+      ; kind= None
-        (IssueType.from_string exn_str, desc, None, Exn_user, High, None, Prover)
+      ; category= Nocat }
-    | Leak (fp_part, _, (exn_vis, error_desc), done_array_abstraction, resource, ml_loc)
+  | Precondition_not_met (desc, ml_loc)
-     -> if done_array_abstraction then
+   -> { name= IssueType.precondition_not_met
-          ( IssueType.leak_after_array_abstraction
+      ; description= desc
-          , error_desc
+      ; ml_loc= Some ml_loc
-          , Some ml_loc
+      ; visibility= Exn_developer
-          , Exn_developer
+      ; severity= Medium
-          , High
+      ; kind= Some Kwarning
-          , None
+      ; category= Nocat }
-          , Prover )
+      (* always a warning *)
-        else if fp_part then
+  | Retain_cycle (_, desc, ml_loc)
-          (IssueType.leak_in_footprint, error_desc, Some ml_loc, Exn_developer, High, None, Prover)
+   -> { name= IssueType.retain_cycle
-        else
+      ; description= desc
-          let loc_str =
+      ; ml_loc= Some ml_loc
-            match resource with
+      ; visibility= Exn_user
-            | PredSymb.Rmemory _
+      ; severity= High
-             -> IssueType.memory_leak
+      ; kind= None
-            | PredSymb.Rfile
+      ; category= Prover }
-             -> IssueType.resource_leak
+  | Registered_observer_being_deallocated (desc, ml_loc)
-            | PredSymb.Rlock
+   -> { name= IssueType.registered_observer_being_deallocated
-             -> IssueType.resource_leak
+      ; description= desc
-            | PredSymb.Rignore
+      ; ml_loc= Some ml_loc
-             -> IssueType.memory_leak
+      ; visibility= Exn_user
-          in
+      ; severity= High
-          (loc_str, error_desc, Some ml_loc, exn_vis, High, None, Prover)
+      ; kind= Some Kerror
-    | Missing_fld (fld, ml_loc)
+      ; category= Nocat }
-     -> let desc = Localise.verbatim_desc (Typ.Fieldname.to_full_string fld) in
+  | Return_expression_required (desc, ml_loc)
-        (IssueType.missing_fld, desc, Some ml_loc, Exn_developer, Medium, None, Nocat)
+   -> { name= IssueType.return_expression_required
-    | Premature_nil_termination (desc, ml_loc)
+      ; description= desc
-     -> (IssueType.premature_nil_termination, desc, Some ml_loc, Exn_user, High, None, Prover)
+      ; ml_loc= Some ml_loc
-    | Parameter_not_null_checked (desc, ml_loc)
+      ; visibility= Exn_user
-     -> ( IssueType.parameter_not_null_checked
+      ; severity= Medium
-        , desc
+      ; kind= None
-        , Some ml_loc
+      ; category= Nocat }
-        , Exn_user
+  | Stack_variable_address_escape (desc, ml_loc)
-        , Medium
+   -> { name= IssueType.stack_variable_address_escape
-        , Some Kwarning
+      ; description= desc
-        , Nocat )
+      ; ml_loc= Some ml_loc
-    | Precondition_not_found (desc, ml_loc)
+      ; visibility= Exn_user
-     -> (IssueType.precondition_not_found, desc, Some ml_loc, Exn_developer, Low, None, Nocat)
+      ; severity= High
-    | Precondition_not_met (desc, ml_loc)
+      ; kind= Some Kerror
-     -> ( IssueType.precondition_not_met
+      ; category= Nocat }
-        , desc
+  | Return_statement_missing (desc, ml_loc)
-        , Some ml_loc
+   -> { name= IssueType.return_statement_missing
-        , Exn_developer
+      ; description= desc
-        , Medium
+      ; ml_loc= Some ml_loc
-        , Some Kwarning
+      ; visibility= Exn_user
-        , Nocat )
+      ; severity= Medium
-        (* always a warning *)
+      ; kind= None
-    | Retain_cycle (_, desc, ml_loc)
+      ; category= Nocat }
-     -> (IssueType.retain_cycle, desc, Some ml_loc, Exn_user, High, None, Prover)
+  | Return_value_ignored (desc, ml_loc)
-    | Registered_observer_being_deallocated (desc, ml_loc)
+   -> { name= IssueType.return_value_ignored
-     -> ( IssueType.registered_observer_being_deallocated
+      ; description= desc
-        , desc
+      ; ml_loc= Some ml_loc
-        , Some ml_loc
+      ; visibility= Exn_user
-        , Exn_user
+      ; severity= Medium
-        , High
+      ; kind= None
-        , Some Kerror
+      ; category= Nocat }
-        , Nocat )
+  | SymOp.Analysis_failure_exe _
-    | Return_expression_required (desc, ml_loc)
+   -> { name= IssueType.failure_exe
-     -> (IssueType.return_expression_required, desc, Some ml_loc, Exn_user, Medium, None, Nocat)
+      ; description= Localise.no_desc
-    | Stack_variable_address_escape (desc, ml_loc)
+      ; ml_loc= None
-     -> ( IssueType.stack_variable_address_escape
+      ; visibility= Exn_system
-        , desc
+      ; severity= Low
-        , Some ml_loc
+      ; kind= None
-        , Exn_user
+      ; category= Nocat }
-        , High
+  | Skip_function desc
-        , Some Kerror
+   -> { name= IssueType.skip_function
-        , Nocat )
+      ; description= desc
-    | Return_statement_missing (desc, ml_loc)
+      ; ml_loc= None
-     -> (IssueType.return_statement_missing, desc, Some ml_loc, Exn_user, Medium, None, Nocat)
+      ; visibility= Exn_developer
-    | Return_value_ignored (desc, ml_loc)
+      ; severity= Low
-     -> (IssueType.return_value_ignored, desc, Some ml_loc, Exn_user, Medium, None, Nocat)
+      ; kind= None
-    | SymOp.Analysis_failure_exe _
+      ; category= Nocat }
-     -> (IssueType.failure_exe, Localise.no_desc, None, Exn_system, Low, None, Nocat)
+  | Skip_pointer_dereference (desc, ml_loc)
-    | Skip_function desc
+   -> { name= IssueType.skip_pointer_dereference
-     -> (IssueType.skip_function, desc, None, Exn_developer, Low, None, Nocat)
+      ; description= desc
-    | Skip_pointer_dereference (desc, ml_loc)
+      ; ml_loc= Some ml_loc
-     -> (IssueType.skip_pointer_dereference, desc, Some ml_loc, Exn_user, Medium, Some Kinfo, Nocat)
+      ; visibility= Exn_user
-        (* always an info *)
+      ; severity= Medium
-    | Symexec_memory_error ml_loc
+      ; kind= Some Kinfo
-     -> ( IssueType.symexec_memory_error
+      ; category= Nocat }
-        , Localise.no_desc
+      (* always an info *)
-        , Some ml_loc
+  | Symexec_memory_error ml_loc
-        , Exn_developer
+   -> { name= IssueType.symexec_memory_error
-        , Low
+      ; description= Localise.no_desc
-        , None
+      ; ml_loc= Some ml_loc
-        , Nocat )
+      ; visibility= Exn_developer
-    | Uninitialized_value (desc, ml_loc)
+      ; severity= Low
-     -> (IssueType.uninitialized_value, desc, Some ml_loc, Exn_user, Medium, None, Nocat)
+      ; kind= None
-    | Unary_minus_applied_to_unsigned_expression (desc, ml_loc)
+      ; category= Nocat }
-     -> ( IssueType.unary_minus_applied_to_unsigned_expression
+  | Uninitialized_value (desc, ml_loc)
-        , desc
+   -> { name= IssueType.uninitialized_value
-        , Some ml_loc
+      ; description= desc
-        , Exn_user
+      ; ml_loc= Some ml_loc
-        , Medium
+      ; visibility= Exn_user
-        , None
+      ; severity= Medium
-        , Nocat )
+      ; kind= None
-    | Unknown_proc
+      ; category= Nocat }
-     -> (IssueType.unknown_proc, Localise.no_desc, None, Exn_developer, Low, None, Nocat)
+  | Unary_minus_applied_to_unsigned_expression (desc, ml_loc)
-    | Unreachable_code_after (desc, ml_loc)
+   -> { name= IssueType.unary_minus_applied_to_unsigned_expression
-     -> (IssueType.unreachable_code_after, desc, Some ml_loc, Exn_user, Medium, None, Nocat)
+      ; description= desc
-    | Unsafe_guarded_by_access (desc, ml_loc)
+      ; ml_loc= Some ml_loc
-     -> (IssueType.unsafe_guarded_by_access, desc, Some ml_loc, Exn_user, High, None, Prover)
+      ; visibility= Exn_user
-    | Use_after_free (desc, ml_loc)
+      ; severity= Medium
-     -> (IssueType.use_after_free, desc, Some ml_loc, Exn_user, High, None, Prover)
+      ; kind= None
-    | Wrong_argument_number ml_loc
+      ; category= Nocat }
-     -> ( IssueType.wrong_argument_number
+  | Unknown_proc
-        , Localise.no_desc
+   -> { name= IssueType.unknown_proc
-        , Some ml_loc
+      ; description= Localise.no_desc
-        , Exn_developer
+      ; ml_loc= None
-        , Low
+      ; visibility= Exn_developer
-        , None
+      ; severity= Low
-        , Nocat )
+      ; kind= None
-    | exn
+      ; category= Nocat }
-     -> L.internal_error "Backend error '%a'. Backtrace:@\n%s" Exn.pp exn (Exn.backtrace ()) ;
+  | Unreachable_code_after (desc, ml_loc)
-        reraise exn
+   -> { name= IssueType.unreachable_code_after
-  in
+      ; description= desc
-  (err_name, desc, ml_loc_opt, visibility, severity, force_kind, eclass)
+      ; ml_loc= Some ml_loc
+      ; visibility= Exn_user
+      ; severity= Medium
+      ; kind= None
+      ; category= Nocat }
+  | Unsafe_guarded_by_access (desc, ml_loc)
+   -> { name= IssueType.unsafe_guarded_by_access
+      ; description= desc
+      ; ml_loc= Some ml_loc
+      ; visibility= Exn_user
+      ; severity= High
+      ; kind= None
+      ; category= Prover }
+  | Use_after_free (desc, ml_loc)
+   -> { name= IssueType.use_after_free
+      ; description= desc
+      ; ml_loc= Some ml_loc
+      ; visibility= Exn_user
+      ; severity= High
+      ; kind= None
+      ; category= Prover }
+  | Wrong_argument_number ml_loc
+   -> { name= IssueType.wrong_argument_number
+      ; description= Localise.no_desc
+      ; ml_loc= Some ml_loc
+      ; visibility= Exn_developer
+      ; severity= Low
+      ; kind= None
+      ; category= Nocat }
+  | exn
+   -> { name= IssueType.failure_exe
+      ; description=
+          Localise.verbatim_desc (F.asprintf "%a: %s" Exn.pp exn (Caml.Printexc.get_backtrace ()))
+      ; ml_loc= None
+      ; visibility= Exn_system
+      ; severity= Low
+      ; kind= None
+      ; category= Nocat }
 
 (** print a description of the exception to the html output *)
 let print_exception_html s exn =
-  let err_name, desc, ml_loc_opt, _, _, _, _ = recognize_exception exn in
+  let error = recognize_exception exn in
   let ml_loc_string =
-    match ml_loc_opt with None -> "" | Some ml_loc -> " " ^ L.ml_loc_to_string ml_loc
+    match error.ml_loc with None -> "" | Some ml_loc -> " " ^ L.ml_loc_to_string ml_loc
   in
-  let desc_str = F.asprintf "%a" Localise.pp_error_desc desc in
+  let desc_str = F.asprintf "%a" Localise.pp_error_desc error.description in
-  L.d_strln_color Red (s ^ err_name.IssueType.unique_id ^ " " ^ desc_str ^ ml_loc_string)
+  L.d_strln_color Red (s ^ error.name.IssueType.unique_id ^ " " ^ desc_str ^ ml_loc_string)
 
 (** string describing an error kind *)
 let err_kind_string = function
@@ -413,5 +698,5 @@ let pp_err ~node_key loc ekind ex_name desc ml_loc_opt fmt () =
 
 (** Return true if the exception is not serious and should be handled in timeout mode *)
 let handle_exception exn =
-  let _, _, _, visibility, _, _, _ = recognize_exception exn in
+  let error = recognize_exception exn in
-  equal_visibility visibility Exn_user || equal_visibility visibility Exn_developer
+  equal_visibility error.visibility Exn_user || equal_visibility error.visibility Exn_developer

infer/src/IR/Exceptions.mli

@@ -166,14 +166,13 @@ val pp_err :
   -> Logging.ml_loc option -> Format.formatter -> unit -> unit
 (** pretty print an error *)
 
-val recognize_exception :
+type t =
-  exn
+  { name: IssueType.t
-  -> IssueType.t
+  ; description: Localise.error_desc
-     * Localise.error_desc
+  ; ml_loc: Logging.ml_loc option  (** location in the infer source code *)
-     * Logging.ml_loc option
+  ; visibility: visibility
-     * visibility
+  ; severity: severity
-     * severity
+  ; kind: err_kind option
-     * err_kind option
+  ; category: err_class }
-     * err_class
+
-(** Turn an exception into an error name, error description,
+val recognize_exception : exn -> t
-    location in ml source, and category *)

infer/src/backend/dotty.ml

@@ -600,8 +600,7 @@ let rec dotty_mk_set_links dotnodes sigma p f cycle =
           in
           let nodes_e = select_nodes_exp_lambda dotnodes e lambda in
           let address_struct_id =
-            try get_coordinate_id (List.hd_exn (List.filter ~f:(is_source_node_of_exp e) nodes_e))
+            get_coordinate_id (List.hd_exn (List.filter ~f:(is_source_node_of_exp e) nodes_e))
-            with exn when SymOp.exn_not_failure exn -> assert false
           in
           (* we need to exclude the address node from the sorce of fields. no fields should start from there*)
           let nl' = List.filter ~f:(fun id -> address_struct_id <> id) nl in

infer/src/backend/interproc.ml

@@ -158,9 +158,7 @@ let path_set_checkout_todo (wl: Worklist.t) (node: Procdesc.Node.t) : Paths.Path
     let visited = Hashtbl.find wl.Worklist.path_set_visited node_id in
     let new_visited = Paths.PathSet.union visited todo in
     Hashtbl.replace wl.Worklist.path_set_visited node_id new_visited ; todo
-  with Not_found ->
+  with Not_found -> L.die InternalError "could not find todo for node %a" Procdesc.Node.pp node
-    L.internal_error "@\n@\nERROR: could not find todo for node %a@\n@." Procdesc.Node.pp node ;
-    assert false
 
 (* =============== END of the edge_set object =============== *)
 
@@ -444,8 +442,11 @@ let forward_tabulate tenv proc_cfg wl =
       propagate_nodes_divergence tenv proc_cfg pset normal_succ_nodes exn_succ_nodes wl ;
       L.d_decrease_indent 1 ;
       L.d_ln ()
-    with exn when Exceptions.handle_exception exn && !Config.footprint ->
+    with exn ->
-      handle_exn exn ; L.d_decrease_indent 1 ; L.d_ln ()
+      let backtrace = Caml.Printexc.get_raw_backtrace () in
+      if Exceptions.handle_exception exn && !Config.footprint then (
+        handle_exn exn ; L.d_decrease_indent 1 ; L.d_ln () )
+      else reraise ~backtrace exn
   in
   let do_node curr_node pathset_todo session handle_exn =
     check_prop_size pathset_todo ;
@@ -471,11 +472,14 @@ let forward_tabulate tenv proc_cfg wl =
       do_node curr_node pathset_todo session handle_exn ;
       if !handle_exn_called then Printer.force_delayed_prints () ;
       do_after_node curr_node
-    with exn when Exceptions.handle_exception exn ->
+    with exn ->
-      handle_exn_node curr_node exn ;
+      let backtrace = Caml.Printexc.get_raw_backtrace () in
-      Printer.force_delayed_prints () ;
+      if Exceptions.handle_exception exn then (
-      do_after_node curr_node ;
+        handle_exn_node curr_node exn ;
-      if not !Config.footprint then raise RE_EXE_ERROR
+        Printer.force_delayed_prints () ;
+        do_after_node curr_node ;
+        if not !Config.footprint then raise RE_EXE_ERROR )
+      else reraise ~backtrace exn
   in
   while not (Worklist.is_empty wl) do
     let curr_node = Worklist.remove wl in
@@ -720,7 +724,7 @@ let collect_postconditions wl tenv proc_cfg : Paths.PathSet.t * Specs.Visitedset
         compute_visited !vset_ref
       in
       (do_join_post pname tenv pathset, visited)
-    with exn when match exn with Exceptions.Leak _ -> true | _ -> false ->
+    with Exceptions.Leak _ ->
       L.d_strln "Leak in post collection" ;
       assert false
   in
@@ -1266,9 +1270,9 @@ let perform_transition proc_cfg tenv proc_name =
         Config.allow_leak := allow_leak ;
         L.(debug Analysis Medium)
           "Error in collect_preconditions for %a@." Typ.Procname.pp proc_name ;
-        let err_name, _, ml_loc_opt, _, _, _, _ = Exceptions.recognize_exception exn in
+        let error = Exceptions.recognize_exception exn in
-        let err_str = "exception raised " ^ err_name.IssueType.unique_id in
+        let err_str = "exception raised " ^ error.name.IssueType.unique_id in
-        L.(debug Analysis Medium) "Error: %s %a@." err_str L.pp_ml_loc_opt ml_loc_opt ; []
+        L.(debug Analysis Medium) "Error: %s %a@." err_str L.pp_ml_loc_opt error.ml_loc ; []
     in
     transition_footprint_re_exe tenv proc_name joined_pres
   in

infer/src/backend/prop.ml

@@ -350,8 +350,7 @@ let pp_prop pe0 f prop =
     (* print in html mode *)
     F.fprintf f "%a%a%a" Io_infer.Html.pp_start_color Pp.Blue do_print ()
       Io_infer.Html.pp_end_color ()
-  else do_print f () 
+  else (* print in text mode *) do_print f ()
-  (** print in text mode *)
 
 let pp_prop_with_typ pe f p = pp_prop {pe with opt= SIM_WITH_TYP} f p
 

infer/src/backend/reporting.ml

@@ -26,10 +26,7 @@ let log_issue_from_errlog err_kind err_log ?loc ?node_id ?session ?ltr ?linters_
     match session with None -> (State.get_session () :> int) | Some session -> session
   in
   let ltr = match ltr with None -> State.get_loc_trace () | Some ltr -> ltr in
-  let issue_type =
+  let issue_type = (Exceptions.recognize_exception exn).name in
-    let err_name, _, _, _, _, _, _ = Exceptions.recognize_exception exn in
-    err_name
-  in
   if not Config.filtering (* no-filtering takes priority *) || issue_type.IssueType.enabled then
     Errlog.log_issue err_kind err_log loc node_id session ltr ?linters_def_file ?doc_url exn
 

infer/src/backend/state.ml

@@ -318,9 +318,9 @@ let process_execution_failures (log_issue: log_issue) pname =
     (* L.out "Node:%a node_ok:%d node_fail:%d@." Procdesc.Node.pp node fs.node_ok fs.node_fail; *)
     match (fs.node_ok, fs.first_failure) with
     | 0, Some (loc, key, _, loc_trace, exn) when not Config.debug_exceptions
-     -> let ex_name, _, ml_loc_opt, _, _, _, _ = Exceptions.recognize_exception exn in
+     -> let error = Exceptions.recognize_exception exn in
-        let desc' = Localise.verbatim_desc ("exception: " ^ ex_name.IssueType.unique_id) in
+        let desc' = Localise.verbatim_desc ("exception: " ^ error.name.IssueType.unique_id) in
-        let exn' = Exceptions.Analysis_stops (desc', ml_loc_opt) in
+        let exn' = Exceptions.Analysis_stops (desc', error.ml_loc) in
         log_issue pname ~loc ~node_id:key ~ltr:loc_trace exn'
     | _
      -> ()

infer/src/backend/symExec.ml

@@ -1400,14 +1400,17 @@ and instrs ?(mask_errors= false) tenv pdesc instrs ppl =
     Sil.d_instr instr ;
     L.d_ln () ;
     try sym_exec tenv pdesc instr p path
-    with exn when SymOp.exn_not_failure exn && mask_errors ->
+    with exn ->
-      let err_name, _, ml_source, _, _, _, _ = Exceptions.recognize_exception exn in
+      let backtrace = Caml.Printexc.get_raw_backtrace () in
-      let loc =
+      if SymOp.exn_not_failure exn && mask_errors then
-        match ml_source with Some ml_loc -> "at " ^ L.ml_loc_to_string ml_loc | None -> ""
+        let error = Exceptions.recognize_exception exn in
-      in
+        let loc =
-      L.d_warning ("Generated Instruction Failed with: " ^ err_name.IssueType.unique_id ^ loc) ;
+          match error.ml_loc with Some ml_loc -> "at " ^ L.ml_loc_to_string ml_loc | None -> ""
-      L.d_ln () ;
+        in
-      [(p, path)]
+        L.d_warning ("Generated Instruction Failed with: " ^ error.name.IssueType.unique_id ^ loc) ;
+        L.d_ln () ;
+        [(p, path)]
+      else reraise ~backtrace exn
   in
   let f plist instr = List.concat_map ~f:(exe_instr instr) plist in
   List.fold ~f ~init:ppl instrs
@@ -1800,9 +1803,12 @@ and sym_exec_wrapper handle_exn tenv proc_cfg instr ((prop: Prop.normal Prop.t),
     L.d_ln () ;
     State.mark_instr_ok () ;
     Paths.PathSet.from_renamed_list results
-  with exn when Exceptions.handle_exception exn && !Config.footprint ->
+  with exn ->
-    handle_exn exn ; (* calls State.mark_instr_fail *)
+    let backtrace = Caml.Printexc.get_raw_backtrace () in
-                     Paths.PathSet.empty
+    if Exceptions.handle_exception exn && !Config.footprint then (
+      handle_exn exn ; (* calls State.mark_instr_fail *)
+                       Paths.PathSet.empty )
+    else reraise ~backtrace exn
 
 (** {2 Lifted Abstract Transfer Functions} *)