From 3d6d55a419960e3383d41ede81d664a41b7eb063 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Javier=20Ch=C3=A1varri?= Date: Wed, 19 Jun 2024 12:32:29 +0200 Subject: [PATCH] Show the context name for errors happening in "alt" contexts (#10414) MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * test: add sample for multi-context error Signed-off-by: Javier Chávarri --- doc/changes/10414.md | 2 + otherlibs/stdune/src/user_message.ml | 16 ++++++-- otherlibs/stdune/src/user_message.mli | 4 ++ src/dune_console/dune_console.ml | 2 + src/dune_engine/action_runner.ml | 14 ++----- src/dune_engine/build_system_error.ml | 2 +- src/dune_engine/process.ml | 21 +++++----- src/dune_engine/process.mli | 2 - src/dune_util/report_error.ml | 9 +++++ .../test-cases/multi-context-error.t | 39 +++++++++++++++++++ 10 files changed, 82 insertions(+), 29 deletions(-) create mode 100644 doc/changes/10414.md create mode 100644 test/blackbox-tests/test-cases/multi-context-error.t diff --git a/doc/changes/10414.md b/doc/changes/10414.md new file mode 100644 index 00000000000..ab9d2cb69a9 --- /dev/null +++ b/doc/changes/10414.md @@ -0,0 +1,2 @@ +- Show the context name for errors happening in non-default contexts. + (#10414, @jchavarri) diff --git a/otherlibs/stdune/src/user_message.ml b/otherlibs/stdune/src/user_message.ml index 793ddbeb2e2..559228fc644 100644 --- a/otherlibs/stdune/src/user_message.ml +++ b/otherlibs/stdune/src/user_message.ml @@ -173,9 +173,11 @@ type t = ; paragraphs : Style.t Pp.t list ; hints : Style.t Pp.t list ; annots : Annots.t + ; context : string option + ; dir : string option } -let compare { loc; paragraphs; hints; annots } t = +let compare { loc; paragraphs; hints; annots; context = _; dir = _ } t = let open Ordering.O in let= () = Option.compare Loc0.compare loc t.loc in let= () = List.compare paragraphs t.paragraphs ~compare:Poly.compare in @@ -185,17 +187,17 @@ let compare { loc; paragraphs; hints; annots } t = let equal a b = Ordering.is_eq (compare a b) -let make ?loc ?prefix ?(hints = []) ?(annots = Annots.empty) paragraphs = +let make ?loc ?prefix ?(hints = []) ?(annots = Annots.empty) ?context ?dir paragraphs = let paragraphs = match prefix, paragraphs with | None, l -> l | Some p, [] -> [ p ] | Some p, x :: l -> Pp.concat ~sep:Pp.space [ p; x ] :: l in - { loc; hints; paragraphs; annots } + { loc; hints; paragraphs; annots; context; dir } ;; -let pp { loc; paragraphs; hints; annots = _ } = +let pp { loc; paragraphs; hints; annots = _; context; dir = _ } = let open Pp.O in let paragraphs = match hints with @@ -226,6 +228,12 @@ let pp { loc; paragraphs; hints; annots = _ } = (Pp.textf "File %S, %s, characters %d-%d:" start.pos_fname lnum start_c stop_c)) :: paragraphs in + let paragraphs = + match context with + | None | Some "default" | Some ".sandbox" -> paragraphs + | Some context -> + Pp.box (Pp.tag Style.Loc (Pp.textf "Context: %s" context)) :: paragraphs + in Pp.vbox (Pp.concat_map paragraphs ~sep:Pp.nop ~f:(fun pp -> Pp.seq pp Pp.cut)) ;; diff --git a/otherlibs/stdune/src/user_message.mli b/otherlibs/stdune/src/user_message.mli index 62345a929be..854f4e5a8f7 100644 --- a/otherlibs/stdune/src/user_message.mli +++ b/otherlibs/stdune/src/user_message.mli @@ -66,6 +66,8 @@ type t = ; paragraphs : Style.t Pp.t list ; hints : Style.t Pp.t list ; annots : Annots.t + ; context : string option + ; dir : string option } val compare : t -> t -> Ordering.t @@ -90,6 +92,8 @@ val make -> ?prefix:Style.t Pp.t -> ?hints:Style.t Pp.t list -> ?annots:Annots.t + -> ?context:string + -> ?dir:string -> Style.t Pp.t list -> t diff --git a/src/dune_console/dune_console.ml b/src/dune_console/dune_console.ml index 1a421572487..ce93f399cb8 100644 --- a/src/dune_console/dune_console.ml +++ b/src/dune_console/dune_console.ml @@ -30,6 +30,8 @@ let blank_line_msg = ; hints = [] ; annots = User_message.Annots.empty ; loc = None + ; context = None + ; dir = None } ;; diff --git a/src/dune_engine/action_runner.ml b/src/dune_engine/action_runner.ml index 586ef2377e9..795d95ac713 100644 --- a/src/dune_engine/action_runner.ml +++ b/src/dune_engine/action_runner.ml @@ -27,7 +27,7 @@ end = struct (* Compound user errors do not contain annotations, so it's fine to marshal them as is. *) ; diff_promotion : Diff_promotion.Annot.t option - ; with_directory : Path.t option + ; with_directory : string option } | Code of Code_error.t | Sys of string @@ -67,17 +67,13 @@ end = struct | Some annot -> User_message.Annots.set annots Diff_promotion.Annot.annot annot | None -> annots in - let annots = - match with_directory with - | Some annot -> - User_message.Annots.set annots Process.with_directory_annot annot - | None -> annots - in User { loc = message.loc ; paragraphs = message.paragraphs ; hints = message.hints ; annots + ; context = None + ; dir = with_directory } | Code err -> Code err | Sys err -> Sys err @@ -106,9 +102,7 @@ end = struct User_message.Annots.find annots Compound_user_error.annot in let diff_promotion = User_message.Annots.find annots Diff_promotion.Annot.annot in - let with_directory = - User_message.Annots.find annots Process.with_directory_annot - in + let with_directory = message.dir in User_with_annots { message ; has_embedded_location diff --git a/src/dune_engine/build_system_error.ml b/src/dune_engine/build_system_error.ml index f34f83398b4..f029a882528 100644 --- a/src/dune_engine/build_system_error.ml +++ b/src/dune_engine/build_system_error.ml @@ -27,7 +27,7 @@ let of_exn (exn : Exn_with_backtrace.t) = in match exn.exn with | User_error.E main -> - let dir = User_message.Annots.find main.annots Process.with_directory_annot in + let dir = Option.map ~f:Path.of_string main.dir in let promotion = User_message.Annots.find main.annots Diff_promotion.Annot.annot in (match User_message.Annots.find main.annots Compound_user_error.annot with | None -> diff --git a/src/dune_engine/process.ml b/src/dune_engine/process.ml index cdff93c369f..a1ddca60a0d 100644 --- a/src/dune_engine/process.ml +++ b/src/dune_engine/process.ml @@ -6,10 +6,6 @@ module Timestamp = Event.Timestamp module Action_output_on_success = Execution_parameters.Action_output_on_success module Action_output_limit = Execution_parameters.Action_output_limit -let with_directory_annot = - User_message.Annots.Key.create ~name:"with-directory" Path.to_dyn -;; - let limit_output = Dune_output_truncation.limit_output ~message:"TRUNCATED BY DUNE" module Failure_mode = struct @@ -529,10 +525,9 @@ end = struct Has_output { with_color; without_color; has_embedded_location } ;; - let get_loc_and_annots ~dir ~metadata ~output = + let get_loc_annots_and_dir ~dir ~metadata ~output = let { loc; annots; _ } = metadata in let dir = Option.value dir ~default:Path.root in - let annots = User_message.Annots.set annots with_directory_annot dir in let annots = match output with | No_output -> annots @@ -547,14 +542,15 @@ end = struct | errors -> User_message.Annots.set annots Compound_user_error.annot errors) else annots in - loc, annots + loc, annots, dir ;; - let fail ~loc ~annots paragraphs = + let fail ?dir ~loc ~annots paragraphs = (* We don't use [User_error.make] as it would add the "Error: " prefix. We don't need this prefix as it is already included in the output of the command. *) - raise (User_error.E (User_message.make ?loc ~annots paragraphs)) + let dir = Option.map ~f:Path.to_string dir in + raise (User_error.E (User_message.make ?dir ?loc ~annots paragraphs)) ;; let verbose t ~id ~metadata ~output ~command_line ~dir = @@ -579,8 +575,9 @@ end = struct | Failed n -> sprintf "exited with code %d" n | Signaled signame -> sprintf "got signal %s" (Signal.name signame) in - let loc, annots = get_loc_and_annots ~dir ~metadata ~output in + let loc, annots, dir = get_loc_annots_and_dir ~dir ~metadata ~output in fail + ~dir ~loc ~annots ((Pp.tag User_message.Style.Kwd (Pp.verbatim "Command") @@ -635,7 +632,7 @@ end = struct then Console.print_user_message (User_message.make paragraphs); n | Error error -> - let loc, annots = get_loc_and_annots ~dir ~metadata ~output in + let loc, annots, dir = get_loc_annots_and_dir ~dir ~metadata ~output in let paragraphs = match verbosity with | Short -> @@ -658,7 +655,7 @@ end = struct | Signaled signame -> [ Pp.textf "Command got signal %s." (Signal.name signame) ])) in - fail ~loc ~annots paragraphs + fail ~dir ~loc ~annots paragraphs ;; end diff --git a/src/dune_engine/process.mli b/src/dune_engine/process.mli index 2d8c43e947b..9bd74ea394a 100644 --- a/src/dune_engine/process.mli +++ b/src/dune_engine/process.mli @@ -4,8 +4,6 @@ open Import module Action_output_on_success := Execution_parameters.Action_output_on_success module Action_output_limit := Execution_parameters.Action_output_limit -val with_directory_annot : Path.t User_message.Annots.Key.t - module Failure_mode : sig (** How to handle sub-process failures *) type ('a, 'b) t = diff --git a/src/dune_util/report_error.ml b/src/dune_util/report_error.ml index 7c30bbe7de5..d30d1f164a3 100644 --- a/src/dune_util/report_error.ml +++ b/src/dune_util/report_error.ml @@ -63,6 +63,15 @@ let get_error_from_exn = function | User_error.E msg -> let has_embedded_location = User_message.has_embedded_location msg in let needs_stack_trace = User_message.needs_stack_trace msg in + let msg = + match msg.dir with + | None -> msg + | Some path -> + let build_context = Path.extract_build_context (Path.of_string path) in + (match build_context with + | None -> msg + | Some (ctxt, _) -> { msg with context = Some ctxt }) + in { responsible = User; msg; has_embedded_location; needs_stack_trace } | Code_error.E e -> code_error ~loc:e.loc ~dyn_without_loc:(Code_error.to_dyn_without_loc e) diff --git a/test/blackbox-tests/test-cases/multi-context-error.t b/test/blackbox-tests/test-cases/multi-context-error.t new file mode 100644 index 00000000000..579d0816e22 --- /dev/null +++ b/test/blackbox-tests/test-cases/multi-context-error.t @@ -0,0 +1,39 @@ + $ cat > dune-project << EOF + > (lang dune 3.15) + > (using melange 0.1) + > (package (name bar) (allow_empty)) + > (package (name baz) (allow_empty)) + > EOF + + $ cat > dune-workspace << EOF + > (lang dune 3.15) + > + > (context default) + > + > (context + > (default + > (name melange))) + > EOF + $ cat > dune << EOF + > (library + > (name foo) + > (public_name bar.foo) + > (enabled_if (= %{context_name} "default"))) + > (library + > (name foo) + > (public_name baz.foo) + > (modes melange) + > (enabled_if (= %{context_name} "melange"))) + > EOF + + $ cat > foo.ml < let t = Str.regexp + > EOF + + $ dune build + Context: melange + File "foo.ml", line 1, characters 8-18: + 1 | let t = Str.regexp + ^^^^^^^^^^ + Error: Unbound module Str + [1]