diff --git a/compiler/catala_utils/cli.ml b/compiler/catala_utils/cli.ml index 2fc0ea47..3eddd739 100644 --- a/compiler/catala_utils/cli.ml +++ b/compiler/catala_utils/cli.ml @@ -199,6 +199,12 @@ module Flags = struct "Behave as if run from the given directory for file and error \ 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 make language @@ -209,7 +215,8 @@ module Flags = struct plugins_dirs disable_warnings max_prec_digits - directory : options = + directory + stop_on_error : options = if debug then Printexc.record_backtrace true; let path_rewrite = match directory with @@ -223,7 +230,8 @@ module Flags = struct (* This sets some global refs for convenience, but most importantly returns the options record. *) 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 Term.( const make @@ -235,7 +243,8 @@ module Flags = struct $ plugins_dirs $ disable_warnings $ max_prec_digits - $ directory) + $ directory + $ stop_on_error) let options = let make input_src name directory options : options = diff --git a/compiler/catala_utils/global.ml b/compiler/catala_utils/global.ml index f18b1413..5257d84f 100644 --- a/compiler/catala_utils/global.ml +++ b/compiler/catala_utils/global.ml @@ -37,6 +37,7 @@ type options = { mutable disable_warnings : bool; mutable max_prec_digits : int; mutable path_rewrite : raw_file -> file; + mutable stop_on_error : bool; } (* Note: we force that the global options (ie options common to all commands) @@ -56,6 +57,7 @@ let options = disable_warnings = false; max_prec_digits = 20; path_rewrite = (fun _ -> assert false); + stop_on_error = false; } let enforce_options @@ -69,6 +71,7 @@ let enforce_options ?disable_warnings ?max_prec_digits ?path_rewrite + ?stop_on_error () = Option.iter (fun x -> options.input_src <- x) input_src; 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.max_prec_digits <- x) max_prec_digits; Option.iter (fun x -> options.path_rewrite <- x) path_rewrite; + Option.iter (fun x -> options.stop_on_error <- x) stop_on_error; options let input_src_file = function FileName f | Contents (_, f) | Stdin f -> f diff --git a/compiler/catala_utils/global.mli b/compiler/catala_utils/global.mli index c851e06e..c6fd7ad0 100644 --- a/compiler/catala_utils/global.mli +++ b/compiler/catala_utils/global.mli @@ -56,6 +56,7 @@ type options = private { mutable disable_warnings : bool; mutable max_prec_digits : int; mutable path_rewrite : raw_file -> file; + mutable stop_on_error : bool; } (** Global options, common to all subcommands (note: the fields are internally mutable only for purposes of the [globals] toplevel value defined below) *) @@ -76,6 +77,7 @@ val enforce_options : ?disable_warnings:bool -> ?max_prec_digits:int -> ?path_rewrite:(raw_file -> file) -> + ?stop_on_error:bool -> unit -> options (** Sets up the global options (side-effect); for specific use-cases only, this diff --git a/compiler/catala_utils/message.ml b/compiler/catala_utils/message.ml index d16e69c3..ca18575e 100644 --- a/compiler/catala_utils/message.ml +++ b/compiler/catala_utils/message.ml @@ -407,32 +407,42 @@ let warning = make ~level:Warning ~cont:emit let error = make ~level:Error ~cont:(fun m _ -> raise (CompilerError m)) (* 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 = 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 -> error ~internal:true "delayed error called outside scope: encapsulate using \ 'with_delayed_errors' first" | Some l -> - global_errors := Some (m :: l); + global_errors.errors <- Some (m :: l); x) -let with_delayed_errors (f : unit -> 'a) : 'a = - (match !global_errors with - | None -> global_errors := Some [] +let with_delayed_errors + ?(stop_on_error = Global.options.stop_on_error) + (f : unit -> 'a) : 'a = + (match global_errors.errors with + | None -> global_errors.errors <- Some [] | Some _ -> error ~internal:true "delayed error called outside scope: encapsulate using \ 'with_delayed_errors' first"); + global_errors.stop_on_error <- stop_on_error; let r = f () in - match !global_errors with + match global_errors.errors with | None -> error ~internal:true "intertwined delayed error scope" | Some [] -> - global_errors := None; + global_errors.errors <- None; r | Some errs -> - global_errors := None; + global_errors.errors <- None; raise (CompilerErrors (List.rev errs)) diff --git a/compiler/catala_utils/message.mli b/compiler/catala_utils/message.mli index d1204ec9..32c33480 100644 --- a/compiler/catala_utils/message.mli +++ b/compiler/catala_utils/message.mli @@ -104,10 +104,13 @@ val results : Content.message list -> unit (** Multiple errors *) -val with_delayed_errors : (unit -> 'a) -> 'a -(** [with_delayed_errors f] calls [f] and registers each error triggered using - [delayed_error]. +val with_delayed_errors : ?stop_on_error:bool -> (unit -> 'a) -> 'a +(** [with_delayed_errors ?stop_on_error f] calls [f] and registers each 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