Wrap hook exceptions and have them printed with the standard mechanism instead of stopping the process.
parent
bfc36003aa
commit
d9f43d733e
|
@ -427,10 +427,19 @@ let () =
|
||||||
Some
|
Some
|
||||||
(errorf ~loc:(in_file !input_name)
|
(errorf ~loc:(in_file !input_name)
|
||||||
"Some fatal warnings were triggered (%d occurrences)" n)
|
"Some fatal warnings were triggered (%d occurrences)" n)
|
||||||
| _ ->
|
|
||||||
None
|
|
||||||
)
|
|
||||||
|
|
||||||
|
| Misc.HookExnWrapper {error = e; hook_name;
|
||||||
|
hook_info={Misc.sourcefile}} ->
|
||||||
|
let sub = match error_of_exn e with
|
||||||
|
| None -> error (Printexc.to_string e)
|
||||||
|
| Some err -> err
|
||||||
|
in
|
||||||
|
Some
|
||||||
|
(errorf ~loc:(in_file sourcefile)
|
||||||
|
"In hook %S:" hook_name
|
||||||
|
~sub:[sub])
|
||||||
|
| _ -> None
|
||||||
|
)
|
||||||
|
|
||||||
external reraise : exn -> 'a = "%reraise"
|
external reraise : exn -> 'a = "%reraise"
|
||||||
|
|
||||||
|
|
|
@ -652,17 +652,27 @@ type hook_info = {
|
||||||
sourcefile : string;
|
sourcefile : string;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
exception HookExnWrapper of
|
||||||
|
{
|
||||||
|
error: exn;
|
||||||
|
hook_name: string;
|
||||||
|
hook_info: hook_info;
|
||||||
|
}
|
||||||
|
|
||||||
exception HookExn of exn
|
exception HookExn of exn
|
||||||
let fold_hooks list info ast =
|
|
||||||
List.fold_left (fun ast (name,f) ->
|
let raise_direct_hook_exn e = raise (HookExn e)
|
||||||
|
|
||||||
|
let fold_hooks list hook_info ast =
|
||||||
|
List.fold_left (fun ast (hook_name,f) ->
|
||||||
try
|
try
|
||||||
f info ast
|
f hook_info ast
|
||||||
with
|
with
|
||||||
| HookExn e -> raise e
|
| HookExn e -> raise e
|
||||||
| e ->
|
| error -> raise (HookExnWrapper {error; hook_name; hook_info})
|
||||||
Printf.eprintf "Error: exception %S while running hook %S on %S\n%!"
|
(* when explicit reraise with backtrace will be available,
|
||||||
(Printexc.to_string e) name info.sourcefile;
|
it should be used here *)
|
||||||
exit 2
|
|
||||||
) ast (List.sort compare list)
|
) ast (List.sort compare list)
|
||||||
|
|
||||||
module type HookSig = sig
|
module type HookSig = sig
|
||||||
|
|
|
@ -297,19 +297,33 @@ val delete_eol_spaces : string -> string
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
(** {2 Hook machinery} *)
|
||||||
|
|
||||||
(* Hooks machinery:
|
(* Hooks machinery:
|
||||||
[add_hook name f] will register a function that will be called on the
|
[add_hook name f] will register a function that will be called on the
|
||||||
argument of a later call to [apply_hooks]. Hooks are applied in the
|
argument of a later call to [apply_hooks]. Hooks are applied in the
|
||||||
lexicographical order of their names.
|
lexicographical order of their names.
|
||||||
*)
|
*)
|
||||||
|
|
||||||
exception HookExn of exn
|
|
||||||
|
|
||||||
type hook_info = {
|
type hook_info = {
|
||||||
sourcefile : string;
|
sourcefile : string;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
exception HookExnWrapper of
|
||||||
|
{
|
||||||
|
error: exn;
|
||||||
|
hook_name: string;
|
||||||
|
hook_info: hook_info;
|
||||||
|
}
|
||||||
|
(** An exception raised by a hook will be wrapped into a [HookExnWrapper] constructor
|
||||||
|
by the hook machinery.
|
||||||
|
*)
|
||||||
|
|
||||||
|
|
||||||
|
val raise_direct_hook_exn: exn -> 'a
|
||||||
|
(** A hook can use [raise_unwrapped_hook_exn] to raise an exception that will
|
||||||
|
not be wrapped into a [HookExnWrapper]. *)
|
||||||
|
|
||||||
module type HookSig = sig
|
module type HookSig = sig
|
||||||
type t
|
type t
|
||||||
val add_hook : string -> (hook_info -> t -> t) -> unit
|
val add_hook : string -> (hook_info -> t -> t) -> unit
|
||||||
|
|
Loading…
Reference in New Issue