Add an option to stop on the first delayed error encountered

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 =

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

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

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))

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