You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.

120 lines
4.3 KiB

(*
* Copyright (c) 2016 - 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.
*)
(** Module for parsing stack traces and using them to guide Infer analysis *)
open! IStd
module F = Format
module L = Logging
type frame = {class_str: string; method_str: string; file_str: string; line_num: int option}
type t = {exception_name: string; frames: frame list}
let new_line_regexp = Str.regexp "\n"
(* Pre-compute the regular expression matchers used to parse: *)
(* Stack frames into (procedure, location) tuples. *)
let frame_regexp = Str.regexp "\t*at \\(.*\\)(\\(.*\\))"
(* procedures into class and method name. *)
let procname_regexp = Str.regexp "\\(.*\\)\\.\\(.*\\)"
(* locations into file and line number information. *)
let file_and_line_regexp = Str.regexp "\\(.*\\):\\([0-9]+\\)"
(* exception information lines into thread id and exception type *)
let exception_regexp = Str.regexp "Exception in thread \"\\(.*\\)\" \\(.*\\)"
let make exception_name frames = {exception_name; frames}
let make_frame class_str method_str file_str line_num = {class_str; method_str; file_str; line_num}
let frame_matches_location frame_obj loc =
let lfname =
if SourceFile.is_invalid loc.Location.file then None
else Some (SourceFile.to_string loc.Location.file)
in
let matches_file =
Option.value_map lfname ~default:false ~f:(String.is_suffix ~suffix:frame_obj.file_str)
in
let matches_line =
match frame_obj.line_num with None -> false | Some line -> Int.equal line loc.Location.line
in
matches_file && matches_line
let parse_stack_frame frame_str =
(* separate the qualified method name and the parenthesized text/line number*)
ignore (Str.string_match frame_regexp frame_str 0) ;
let qualified_procname = Str.matched_group 1 frame_str in
let file_and_line = Str.matched_group 2 frame_str in
(* separate the class name from the method name *)
ignore (Str.string_match procname_regexp qualified_procname 0) ;
let class_str = Str.matched_group 1 qualified_procname in
let method_str = Str.matched_group 2 qualified_procname in
(* Native methods don't have debugging info *)
if String.equal file_and_line "Native Method" then
make_frame class_str method_str "Native Method" None
else
(* Separate the filename and line number.
note that a few methods might not have line number information,
for those, file_and_line includes only the filename. *)
let is_file_line = Str.string_match file_and_line_regexp file_and_line 0 in
let file_str, line_num =
if is_file_line then
( Str.matched_group 1 file_and_line
, Some (int_of_string (Str.matched_group 2 file_and_line)) )
else (file_and_line, None)
in
make_frame class_str method_str file_str line_num
let parse_exception_line exception_line =
ignore (Str.string_match exception_regexp exception_line 0) ;
let exception_name = Str.matched_group 2 exception_line in
exception_name
let of_string s =
let lines = Str.split new_line_regexp s in
match lines with
| exception_line :: trace ->
let exception_name = parse_exception_line exception_line in
let parsed = List.map ~f:parse_stack_frame trace in
make exception_name parsed
| [] ->
L.(die UserError) "Empty stack trace"
let of_json filename json =
let exception_name_key = "exception_type" in
let frames_key = "stack_trace" in
let extract_json_member key =
match Yojson.Basic.Util.member key json with
| `Null ->
L.(die UserError) "Missing key in supplied JSON data: %s (in file %s)" key filename
| item ->
item
in
let exception_name = Yojson.Basic.Util.to_string (extract_json_member exception_name_key) in
let frames =
Yojson.Basic.Util.to_list (extract_json_member frames_key)
|> List.map ~f:Yojson.Basic.Util.to_string |> List.map ~f:String.strip
|> List.filter ~f:(fun s -> s <> "") |> List.map ~f:parse_stack_frame
in
make exception_name frames
let of_json_file filename =
try of_json filename (Yojson.Basic.from_file filename) with
| Sys_error msg | Yojson.Json_error msg ->
L.(die UserError)
"Could not read or parse the supplied JSON stacktrace file %s :@\n %s" filename msg