Add an option to stop on the first delayed error encountered

This commit is contained in:
vbot 2024-06-17 17:38:27 +02:00
parent a2c023c24c
commit 9622ac4172
No known key found for this signature in database
GPG Key ID: A102739F983C6C72
5 changed files with 44 additions and 16 deletions

View File

@ -199,6 +199,12 @@ module Flags = struct
"Behave as if run from the given directory for file and error \ "Behave as if run from the given directory for file and error \
reporting. Does not affect resolution of files in arguments." reporting. Does not affect resolution of files in arguments."
let stop_on_error =
value
& flag
& info ["x"; "stop-on-error"]
~doc:"Stops the compilation as soon as an error is encountered."
let flags = let flags =
let make let make
language language
@ -209,7 +215,8 @@ module Flags = struct
plugins_dirs plugins_dirs
disable_warnings disable_warnings
max_prec_digits max_prec_digits
directory : options = directory
stop_on_error : options =
if debug then Printexc.record_backtrace true; if debug then Printexc.record_backtrace true;
let path_rewrite = let path_rewrite =
match directory with match directory with
@ -223,7 +230,8 @@ module Flags = struct
(* This sets some global refs for convenience, but most importantly (* This sets some global refs for convenience, but most importantly
returns the options record. *) returns the options record. *)
Global.enforce_options ~language ~debug ~color ~message_format ~trace Global.enforce_options ~language ~debug ~color ~message_format ~trace
~plugins_dirs ~disable_warnings ~max_prec_digits ~path_rewrite () ~plugins_dirs ~disable_warnings ~max_prec_digits ~path_rewrite
~stop_on_error ()
in in
Term.( Term.(
const make const make
@ -235,7 +243,8 @@ module Flags = struct
$ plugins_dirs $ plugins_dirs
$ disable_warnings $ disable_warnings
$ max_prec_digits $ max_prec_digits
$ directory) $ directory
$ stop_on_error)
let options = let options =
let make input_src name directory options : options = let make input_src name directory options : options =

View File

@ -37,6 +37,7 @@ type options = {
mutable disable_warnings : bool; mutable disable_warnings : bool;
mutable max_prec_digits : int; mutable max_prec_digits : int;
mutable path_rewrite : raw_file -> file; mutable path_rewrite : raw_file -> file;
mutable stop_on_error : bool;
} }
(* Note: we force that the global options (ie options common to all commands) (* Note: we force that the global options (ie options common to all commands)
@ -56,6 +57,7 @@ let options =
disable_warnings = false; disable_warnings = false;
max_prec_digits = 20; max_prec_digits = 20;
path_rewrite = (fun _ -> assert false); path_rewrite = (fun _ -> assert false);
stop_on_error = false;
} }
let enforce_options let enforce_options
@ -69,6 +71,7 @@ let enforce_options
?disable_warnings ?disable_warnings
?max_prec_digits ?max_prec_digits
?path_rewrite ?path_rewrite
?stop_on_error
() = () =
Option.iter (fun x -> options.input_src <- x) input_src; Option.iter (fun x -> options.input_src <- x) input_src;
Option.iter (fun x -> options.language <- x) language; Option.iter (fun x -> options.language <- x) language;
@ -80,6 +83,7 @@ let enforce_options
Option.iter (fun x -> options.disable_warnings <- x) disable_warnings; Option.iter (fun x -> options.disable_warnings <- x) disable_warnings;
Option.iter (fun x -> options.max_prec_digits <- x) max_prec_digits; Option.iter (fun x -> options.max_prec_digits <- x) max_prec_digits;
Option.iter (fun x -> options.path_rewrite <- x) path_rewrite; Option.iter (fun x -> options.path_rewrite <- x) path_rewrite;
Option.iter (fun x -> options.stop_on_error <- x) stop_on_error;
options options
let input_src_file = function FileName f | Contents (_, f) | Stdin f -> f let input_src_file = function FileName f | Contents (_, f) | Stdin f -> f

View File

@ -56,6 +56,7 @@ type options = private {
mutable disable_warnings : bool; mutable disable_warnings : bool;
mutable max_prec_digits : int; mutable max_prec_digits : int;
mutable path_rewrite : raw_file -> file; mutable path_rewrite : raw_file -> file;
mutable stop_on_error : bool;
} }
(** Global options, common to all subcommands (note: the fields are internally (** Global options, common to all subcommands (note: the fields are internally
mutable only for purposes of the [globals] toplevel value defined below) *) mutable only for purposes of the [globals] toplevel value defined below) *)
@ -76,6 +77,7 @@ val enforce_options :
?disable_warnings:bool -> ?disable_warnings:bool ->
?max_prec_digits:int -> ?max_prec_digits:int ->
?path_rewrite:(raw_file -> file) -> ?path_rewrite:(raw_file -> file) ->
?stop_on_error:bool ->
unit -> unit ->
options options
(** Sets up the global options (side-effect); for specific use-cases only, this (** Sets up the global options (side-effect); for specific use-cases only, this

View File

@ -407,32 +407,42 @@ let warning = make ~level:Warning ~cont:emit
let error = make ~level:Error ~cont:(fun m _ -> raise (CompilerError m)) let error = make ~level:Error ~cont:(fun m _ -> raise (CompilerError m))
(* Multiple errors handling *) (* Multiple errors handling *)
let global_errors = ref None
type global_errors = {
mutable errors : t list option;
mutable stop_on_error : bool;
}
let global_errors = { errors = None; stop_on_error = false }
let delayed_error x = let delayed_error x =
make ~level:Error ~cont:(fun m _ -> make ~level:Error ~cont:(fun m _ ->
match !global_errors with if global_errors.stop_on_error then raise (CompilerError m);
match global_errors.errors with
| None -> | None ->
error ~internal:true error ~internal:true
"delayed error called outside scope: encapsulate using \ "delayed error called outside scope: encapsulate using \
'with_delayed_errors' first" 'with_delayed_errors' first"
| Some l -> | Some l ->
global_errors := Some (m :: l); global_errors.errors <- Some (m :: l);
x) x)
let with_delayed_errors (f : unit -> 'a) : 'a = let with_delayed_errors
(match !global_errors with ?(stop_on_error = Global.options.stop_on_error)
| None -> global_errors := Some [] (f : unit -> 'a) : 'a =
(match global_errors.errors with
| None -> global_errors.errors <- Some []
| Some _ -> | Some _ ->
error ~internal:true error ~internal:true
"delayed error called outside scope: encapsulate using \ "delayed error called outside scope: encapsulate using \
'with_delayed_errors' first"); 'with_delayed_errors' first");
global_errors.stop_on_error <- stop_on_error;
let r = f () in let r = f () in
match !global_errors with match global_errors.errors with
| None -> error ~internal:true "intertwined delayed error scope" | None -> error ~internal:true "intertwined delayed error scope"
| Some [] -> | Some [] ->
global_errors := None; global_errors.errors <- None;
r r
| Some errs -> | Some errs ->
global_errors := None; global_errors.errors <- None;
raise (CompilerErrors (List.rev errs)) raise (CompilerErrors (List.rev errs))

View File

@ -104,10 +104,13 @@ val results : Content.message list -> unit
(** Multiple errors *) (** Multiple errors *)
val with_delayed_errors : (unit -> 'a) -> 'a val with_delayed_errors : ?stop_on_error:bool -> (unit -> 'a) -> 'a
(** [with_delayed_errors f] calls [f] and registers each error triggered using (** [with_delayed_errors ?stop_on_error f] calls [f] and registers each error
[delayed_error]. triggered using [delayed_error]. [stop_on_error] defaults to
[Global.options.stop_on_error].
@raise CompilerErrors when delayed errors were registered. *) @raise CompilerErrors when delayed errors were registered.
@raise CompilerError
on the first error encountered when the [stop_on_error] flag is set. *)
val delayed_error : 'b -> ('a, 'b) emitter val delayed_error : 'b -> ('a, 'b) emitter