Ekdohibs
/
ocaml
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Reformulation of the user-facing slot-access API 

- The internal [backtrace_slot] type is not exposed anymore, instead
  accessors function return orthogonal information
  (is_raise, location). This is both more extensible and more
  user-friendly.

- The [raw_backtrace_slot] is exposed separately as a low-level type
  that most users should never use. The unsafety of marshalling is
  documented. Instead of defining
  [raw_backtrace = raw_backtrace_slot array], I kept [raw_backtrace]
  an abstract type with [length] and [get] functions for
  random-access. This should allow us to change the implementation in
  the future to be more robust wrt. marshalling (boxing the trace in
  a Custom block, or even possibly the raw slots at access time).

git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@14784 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02
master
Gabriel Scherer 2014-05-10 19:20:00 +00:00
parent 286fbaa0c1
commit 755b19650b
4 changed files with 222 additions and 68 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

84
stdlib/printexc.ml
View File

@ -106,24 +106,20 @@ let convert_raw_backtrace rbckt =
try Some (Array.map convert_raw_backtrace_slot rbckt)
with Failure _ -> None
let format_backtrace_slot pos li =
let is_raise =
match li with
| Known_location(is_raise, _, _, _, _) -> is_raise
| Unknown_location(is_raise) -> is_raise in
let info =
let format_backtrace_slot pos slot =
let info is_raise =
if is_raise then
if pos = 0 then "Raised at" else "Re-raised at"
else
if pos = 0 then "Raised by primitive operation at" else "Called from"
in
match li with
match slot with
| Unknown_location true -> (* compiler-inserted re-raise, skipped *) None
| Unknown_location false ->
Some (sprintf "%s unknown location" (info false))
| Known_location(is_raise, filename, lineno, startchar, endchar) ->
sprintf "%s file \"%s\", line %d, characters %d-%d"
info filename lineno startchar endchar
| Unknown_location(is_raise) ->
sprintf "%s unknown location"
info
Some (sprintf "%s file \"%s\", line %d, characters %d-%d"
(info is_raise) filename lineno startchar endchar)
let print_exception_backtrace outchan backtrace =
match backtrace with
@ -132,8 +128,9 @@ let print_exception_backtrace outchan backtrace =
"(Program not linked with -g, cannot print stack backtrace)\n"
| Some a ->
for i = 0 to Array.length a - 1 do
if a.(i) <> Unknown_location true then
fprintf outchan "%s\n" (format_backtrace_slot i a.(i))
match format_backtrace_slot i a.(i) with
| None -> ()
| Some str -> fprintf outchan "%s\n" str
done
let print_raw_backtrace outchan raw_backtrace =
@ -150,14 +147,67 @@ let backtrace_to_string backtrace =
| Some a ->
let b = Buffer.create 1024 in
for i = 0 to Array.length a - 1 do
if a.(i) <> Unknown_location true then
bprintf b "%s\n" (format_backtrace_slot i a.(i))
match format_backtrace_slot i a.(i) with
| None -> ()
| Some str -> bprintf b "%s\n" str
done;
Buffer.contents b
let raw_backtrace_to_string raw_backtrace =
backtrace_to_string (convert_raw_backtrace raw_backtrace)
let backtrace_slot_is_raise = function
| Known_location(is_raise, _, _, _, _) -> is_raise
| Unknown_location(is_raise) -> is_raise
type location = {
filename : string;
line_number : int;
start_char : int;
end_char : int;
}
let backtrace_slot_location = function
| Unknown_location _ -> None
| Known_location(_is_raise, filename, line_number,
start_char, end_char) ->
Some {
filename;
line_number;
start_char;
end_char;
}
let backtrace_slots raw_backtrace =
(* The documentation of this function guarantees that Some is
returned only if a part of the trace is usable. This gives us
a bit more work than just convert_raw_backtrace, but it makes the
API more user-friendly -- otherwise most users would have to
reimplement the "Program not linked with -g, sorry" logic
themselves. *)
match convert_raw_backtrace raw_backtrace with
| None -> None
| Some backtrace ->
let usable_slot = function
| Unknown_location _ -> false
| Known_location _ -> true in
let rec exists_usable = function
| (-1) -> false
| i -> usable_slot backtrace.(i) || exists_usable (i - 1) in
if exists_usable (Array.length backtrace - 1)
then Some backtrace
else None
module Slot = struct
type t = backtrace_slot
let format = format_backtrace_slot
let is_raise = backtrace_slot_is_raise
let location = backtrace_slot_location
end
let raw_backtrace_length bckt = Array.length bckt
let get_raw_backtrace_slot bckt i = Array.get bckt i
(* confusingly named:
returns the *string* corresponding to the global current backtrace *)
let get_backtrace () =
@ -169,10 +219,8 @@ external backtrace_status: unit -> bool = "caml_backtrace_status"
let register_printer fn =
printers := fn :: !printers
external get_callstack: int -> raw_backtrace = "caml_get_current_callstack"
let exn_slot x =
let x = Obj.repr x in
if Obj.tag x = 0 then Obj.field x 0 else x

179
stdlib/printexc.mli
View File

@ -85,25 +85,54 @@ val register_printer: (exn -> string option) -> unit
(** {6 Raw backtraces} *)
type raw_backtrace_slot
type raw_backtrace = raw_backtrace_slot array
(** The abstract type [raw_backtrace_slot] stores a slot of a backtrace in
type raw_backtrace
(** The abstract type [raw_backtrace] stores a backtrace in
a low-level format, instead of directly exposing them as string as
the [get_backtrace()] function does.
This allows delaying the formatting of backtraces to when they are
actually printed, which might be useful if you record more
actually printed, which may be useful if you record more
backtraces than you print.
Elements of type raw_backtrace_slot can be compared and hashed: when two
elements are equal, then they represent the same source location (the
converse is not necessarily true in presence of inlining, for example).
Raw backtraces cannot be marshalled. If you need marshalling, you
should use the array returned by the [backtrace_slots] function of
the next section.
@since 4.01.0
*)
val get_raw_backtrace: unit -> raw_backtrace
(** [Printexc.get_raw_backtrace ()] returns the same exception
backtrace that [Printexc.print_backtrace] would print, but in
a raw format.
@since 4.01.0
*)
val print_raw_backtrace: out_channel -> raw_backtrace -> unit
(** Print a raw backtrace in the same format
[Printexc.print_backtrace] uses.
@since 4.01.0
*)
val raw_backtrace_to_string: raw_backtrace -> string
(** Return a string from a raw backtrace, in the same format
[Printexc.get_backtrace] uses.
@since 4.01.0
*)
(** {6 Current call stack} *)
val get_callstack: int -> raw_backtrace
(** [Printexc.get_callstack n] returns a description of the top of the
call stack on the current program point (for the current thread),
with at most [n] entries. (Note: this function is not related to
exceptions at all, despite being part of the [Printexc] module.)
@since 4.01.0
*)
(** {6 Uncaught exceptions} *)
@ -121,46 +150,120 @@ val set_uncaught_exception_handler: (exn -> raw_backtrace -> unit) -> unit
@since 4.02.0
*)
(** {6 Backtrace slots processing} *)
type backtrace_slot =
| Known_location of bool (* is_raise *)
* string (* filename *)
* int (* line number *)
* int (* start char *)
* int (* end char *)
| Unknown_location of bool (*is_raise*)
(** {6 Manipulation of backtrace information}
(** [convert_raw_backtrace_slot] converts one slot of a raw backtrace
to an Ocaml algebraic datatype representing to location
information in the source file.
Raises [Failure] if not able to load debug information.
Those function allow to traverse the slots of a raw backtrace,
extract information from them in a programmer-friendly format.
*)
val convert_raw_backtrace_slot: raw_backtrace_slot -> backtrace_slot
(** [format_backtrace_slot pos slot] returns the string
representation of the backtrace slot [slot] as
[raw_backtrace_to_string] would format it, assuming it is the
[pos]-th element of the backtrace: the 0-th element is
pretty-printed differently than the other.
type backtrace_slot
(** The abstract type [backtrace_slot] represents a single slot of
a backtrace.
Note that Printexc's printing function will skip any slot equal to
[Unknown_location true]; you should as well if you wish to
reproduce its behavior.
@since 4.02
*)
val format_backtrace_slot : int -> backtrace_slot -> string
(** {6 Current call stack} *)
val backtrace_slots : raw_backtrace -> backtrace_slot array option
(** Returns the slots of a raw backtrace, or [None] if none of them
contain useful information.
val get_callstack: int -> raw_backtrace
In the return array, the slot at index [0] corresponds to the most
recent function call, raise, or primitive [get_backtrace] call in
the trace.
(** [Printexc.get_callstack n] returns a description of the top of the
call stack on the current program point (for the current thread),
with at most [n] entries. (Note: this function is not related to
exceptions at all, despite being part of the [Printexc] module.)
Some possible reasons for returning [None] are as follow:
- none of the slots in the trace come from modules compiled with
debug information ([-g])
- the program is a bytecode program that has not been linked with
debug information enabled ([ocamlc -g])
*)
@since 4.01.0
type location = {
filename : string;
line_number : int;
start_char : int;
end_char : int;
}
(** The type of location information found in backtraces. [start_char]
and [end_char] are positions relative to the beginning of the
line.
@since 4.02
*)
module Slot : sig
type t = backtrace_slot
val is_raise : t -> bool
(** [is_raise slot] is [true] when [slot] refers to a raising
point in the code, and [false] when it comes from a simple
function call.
@since 4.02
*)
val location : t -> location option
(** [location slot] returns the location information of the slot,
if available, and [None] otherwise.
Some possible reasons for failing to return a location are as follow:
- the slot corresponds to a compiler-inserted raise
- the slot corresponds to a part of the program that has not been
compiled with debug information ([-g])
@since 4.02
*)
val format : int -> t -> string option
(** [format pos slot] returns the string representation of [slot] as
[raw_backtrace_to_string] would format it, assuming it is the
[pos]-th element of the backtrace: the [0]-th element is
pretty-printed differently than the others.
Whole-backtrace printing functions also skip some uninformative
slots; in that case, [format pos slot] returns [None].
@since 4.02
*)
end
(** {6 Raw backtrace slots} *)
type raw_backtrace_slot
(** This type allows direct access to raw backtrace slots, without any
conversion in an OCaml-usable data-structure. Being
process-specific, they must absolutely not be marshalled, and are
unsafe to use for this reason (marshalling them may not fail, but
un-marshalling and using the result will result in
undefined behavior).
Elements of this type can still be compared and hashed: when two
elements are equal, then they represent the same source location
(the converse is not necessarily true in presence of inlining,
for example).
*)
val raw_backtrace_length : raw_backtrace -> int
(** [raw_backtrace_length bckt] returns the number of slots in the
backtrace [bckt].
@since 4.02
*)
val get_raw_backtrace_slot : raw_backtrace -> int -> raw_backtrace_slot
(** [get_slot bckt pos] returns the slot in position [pos] in the
backtrace [bckt].
@since 4.02
*)
val convert_raw_backtrace_slot : raw_backtrace_slot -> backtrace_slot
(** Extracts the user-friendly [backtrace_slot] from a low-level
[raw_backtrace_slot].
@since 4.02
*)

6
testsuite/tests/backtrace/backtrace_deprecated.ml
View File

@ -36,9 +36,9 @@ let run args =
| None -> ()
| Some trace ->
Array.iteri
(fun i slot ->
if slot <> Printexc.Unknown_location true then
print_endline (Printexc.format_backtrace_slot i slot))
(fun i slot -> match Printexc.Slot.format i slot with
| None -> ()
| Some line -> print_endline line)
trace
let _ =

21
testsuite/tests/backtrace/backtrace_slots.ml
View File

@ -14,28 +14,31 @@
let get_backtrace () =
let raw_backtrace = Printexc.get_raw_backtrace () in
let raw_slots =
Array.init (Printexc.raw_backtrace_length raw_backtrace)
(Printexc.get_raw_backtrace_slot raw_backtrace) in
let convert = Printexc.convert_raw_backtrace_slot in
let backtrace = Array.map convert raw_backtrace in
(* we'll play with slots a bit to check that hashing and comparison work:
let backtrace = Array.map convert raw_slots in
(* we'll play with raw slots a bit to check that hashing and comparison work:
- create a hashtable that maps slots to their index in the raw backtrace
- create a balanced set of all slots
*)
let table = Hashtbl.create 100 in
Array.iteri (fun i slot -> Hashtbl.add table slot i) raw_backtrace;
Array.iteri (fun i slot -> Hashtbl.add table slot i) raw_slots;
let module S = Set.Make(struct
type t = Printexc.raw_backtrace_slot
let compare = Pervasives.compare
end) in
let slots = Array.fold_right S.add raw_backtrace S.empty in
let slots = Array.fold_right S.add raw_slots S.empty in
Array.iteri (fun i slot ->
assert (S.mem slot slots);
assert (Hashtbl.mem table slot);
let j =
(* position in the table of the last slot equal to [slot] *)
Hashtbl.find table slot in
assert (slot = raw_backtrace.(j));
assert (slot = raw_slots.(j));
assert (backtrace.(i) = backtrace.(j));
) raw_backtrace;
) raw_slots;
backtrace
exception Error of string
@ -56,9 +59,9 @@ let run args =
with exn ->
Printf.printf "Uncaught exception %s\n" (Printexc.to_string exn);
get_backtrace () |> Array.iteri
(fun i slot ->
if slot <> Printexc.Unknown_location true then
print_endline (Printexc.format_backtrace_slot i slot))
(fun i slot -> match Printexc.Slot.format i slot with
| None -> ()
| Some line -> print_endline line)
let _ =
Printexc.record_backtrace true;