From 31a62f70b97b1be8aeaf90d3d3a08cae4711e16f Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Javier=20Ch=C3=A1varri?= Date: Thu, 11 Apr 2024 16:32:49 +0000 Subject: [PATCH 1/8] test: add sample for multi-context error MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Signed-off-by: Javier Chávarri --- .../test-cases/multi-context-error.t | 38 +++++++++++++++++++ 1 file changed, 38 insertions(+) create mode 100644 test/blackbox-tests/test-cases/multi-context-error.t 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..85524a6b0a8 --- /dev/null +++ b/test/blackbox-tests/test-cases/multi-context-error.t @@ -0,0 +1,38 @@ + $ 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 + File "foo.ml", line 1, characters 8-18: + 1 | let t = Str.regexp + ^^^^^^^^^^ + Error: Unbound module Str + [1] From 6dafe5e2986757cf897135ca9c5372e555416da7 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Javier=20Ch=C3=A1varri?= Date: Thu, 11 Apr 2024 16:35:06 +0000 Subject: [PATCH 2/8] log context on errors MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Signed-off-by: Javier Chávarri --- otherlibs/stdune/src/user_message.ml | 15 ++++++++---- otherlibs/stdune/src/user_message.mli | 2 ++ src/dune_console/dune_console.ml | 1 + src/dune_engine/action_runner.ml | 1 + src/dune_engine/process.ml | 24 +++++++++++++++---- .../test-cases/multi-context-error.t | 1 + 6 files changed, 36 insertions(+), 8 deletions(-) diff --git a/otherlibs/stdune/src/user_message.ml b/otherlibs/stdune/src/user_message.ml index 793ddbeb2e2..5a78255a90e 100644 --- a/otherlibs/stdune/src/user_message.ml +++ b/otherlibs/stdune/src/user_message.ml @@ -173,9 +173,10 @@ type t = ; paragraphs : Style.t Pp.t list ; hints : Style.t Pp.t list ; annots : Annots.t + ; context : string option } -let compare { loc; paragraphs; hints; annots } t = +let compare { loc; paragraphs; hints; annots; context = _ } 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 +186,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 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 } ;; -let pp { loc; paragraphs; hints; annots = _ } = +let pp { loc; paragraphs; hints; annots = _; context } = let open Pp.O in let paragraphs = match hints with @@ -226,6 +227,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 -> 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..363b41e309f 100644 --- a/otherlibs/stdune/src/user_message.mli +++ b/otherlibs/stdune/src/user_message.mli @@ -66,6 +66,7 @@ type t = ; paragraphs : Style.t Pp.t list ; hints : Style.t Pp.t list ; annots : Annots.t + ; context : string option } val compare : t -> t -> Ordering.t @@ -90,6 +91,7 @@ val make -> ?prefix:Style.t Pp.t -> ?hints:Style.t Pp.t list -> ?annots:Annots.t + -> ?context: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..f1828af185f 100644 --- a/src/dune_console/dune_console.ml +++ b/src/dune_console/dune_console.ml @@ -30,6 +30,7 @@ let blank_line_msg = ; hints = [] ; annots = User_message.Annots.empty ; loc = None + ; context = None } ;; diff --git a/src/dune_engine/action_runner.ml b/src/dune_engine/action_runner.ml index e2a22b01899..4e9d93cf4c7 100644 --- a/src/dune_engine/action_runner.ml +++ b/src/dune_engine/action_runner.ml @@ -78,6 +78,7 @@ end = struct ; paragraphs = message.paragraphs ; hints = message.hints ; annots + ; context = None } | Code err -> Code err | Sys err -> Sys err diff --git a/src/dune_engine/process.ml b/src/dune_engine/process.ml index cdff93c369f..4413d707d95 100644 --- a/src/dune_engine/process.ml +++ b/src/dune_engine/process.ml @@ -488,6 +488,7 @@ module Handle_exit_status : sig -> output:string -> command_line:User_message.Style.t Pp.t -> dir:Path.t option + -> context:string option -> 'a val non_verbose @@ -500,6 +501,7 @@ module Handle_exit_status : sig -> dir:Path.t option -> has_unexpected_stdout:bool -> has_unexpected_stderr:bool + -> context:string option -> 'a end = struct open Exit_status @@ -550,14 +552,14 @@ end = struct loc, annots ;; - let fail ~loc ~annots paragraphs = + let fail ~loc ~annots ~context 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)) + raise (User_error.E (User_message.make ?loc ~annots ?context paragraphs)) ;; - let verbose t ~id ~metadata ~output ~command_line ~dir = + let verbose t ~id ~metadata ~output ~command_line ~dir ~context = let open Pp.O in let output = parse_output output in match t with @@ -583,6 +585,7 @@ end = struct fail ~loc ~annots + ~context ((Pp.tag User_message.Style.Kwd (Pp.verbatim "Command") ++ Pp.space ++ pp_id id @@ -603,6 +606,7 @@ end = struct ~dir ~has_unexpected_stdout ~has_unexpected_stderr + ~context = let output = parse_output output in let show_command = @@ -658,7 +662,7 @@ end = struct | Signaled signame -> [ Pp.textf "Command got signal %s." (Signal.name signame) ])) in - fail ~loc ~annots paragraphs + fail ~loc ~annots ~context paragraphs ;; end @@ -986,6 +990,15 @@ let run_internal | None -> dir | Some p -> if Path.is_root p then None else Some p in + let context = + let build_context = + match dir with + | None -> None + | Some path -> Build_context.of_build_path (Path.as_in_build_dir_exn path) + in + Option.map build_context ~f:(fun build_context -> + Context_name.to_string build_context.name) + in let id = Running_jobs.Id.gen () in let prog_str = Path.reach_for_running ?from:dir prog in let command_line = @@ -1000,6 +1013,7 @@ let run_internal in Console.print_user_message (User_message.make + ?context [ Pp.tag User_message.Style.Kwd (Pp.verbatim "Running") ++ pp_id id ++ Pp.verbatim ": " @@ -1070,6 +1084,7 @@ let run_internal ~dir ~command_line:fancy_command_line ~output + ~context | _ -> Handle_exit_status.non_verbose result.exit_status @@ -1081,6 +1096,7 @@ let run_internal ~verbosity:display ~has_unexpected_stdout:result.stdout.unexpected_output ~has_unexpected_stderr:result.stderr.unexpected_output + ~context in Result.close result; res, times) diff --git a/test/blackbox-tests/test-cases/multi-context-error.t b/test/blackbox-tests/test-cases/multi-context-error.t index 85524a6b0a8..579d0816e22 100644 --- a/test/blackbox-tests/test-cases/multi-context-error.t +++ b/test/blackbox-tests/test-cases/multi-context-error.t @@ -31,6 +31,7 @@ > EOF $ dune build + Context: melange File "foo.ml", line 1, characters 8-18: 1 | let t = Str.regexp ^^^^^^^^^^ From 42b349e2d6aa3cba5aa3fb49435b99509fee3955 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Javier=20Ch=C3=A1varri?= Date: Thu, 11 Apr 2024 16:40:18 +0000 Subject: [PATCH 3/8] small fixes MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Signed-off-by: Javier Chávarri --- otherlibs/stdune/src/user_message.ml | 2 +- src/dune_engine/process.ml | 5 ++++- 2 files changed, 5 insertions(+), 2 deletions(-) diff --git a/otherlibs/stdune/src/user_message.ml b/otherlibs/stdune/src/user_message.ml index 5a78255a90e..b79be8ab00c 100644 --- a/otherlibs/stdune/src/user_message.ml +++ b/otherlibs/stdune/src/user_message.ml @@ -229,7 +229,7 @@ let pp { loc; paragraphs; hints; annots = _; context } = in let paragraphs = match context with - | None -> paragraphs + | None | Some "default" -> paragraphs | Some context -> Pp.box (Pp.tag Style.Loc (Pp.textf "Context: %s" context)) :: paragraphs in diff --git a/src/dune_engine/process.ml b/src/dune_engine/process.ml index 4413d707d95..dc85d9052b1 100644 --- a/src/dune_engine/process.ml +++ b/src/dune_engine/process.ml @@ -994,7 +994,10 @@ let run_internal let build_context = match dir with | None -> None - | Some path -> Build_context.of_build_path (Path.as_in_build_dir_exn path) + | Some path -> + (match Path.as_in_build_dir path with + | None -> None + | Some path -> Build_context.of_build_path path) in Option.map build_context ~f:(fun build_context -> Context_name.to_string build_context.name) From 63f17d133763693cfd77c048ae7aa960c136554a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Javier=20Ch=C3=A1varri?= Date: Fri, 12 Apr 2024 09:59:12 +0000 Subject: [PATCH 4/8] move context annot in user errors to report_error MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Signed-off-by: Javier Chávarri --- src/dune_engine/action_runner.ml | 7 ++++-- src/dune_engine/build_system_error.ml | 4 ++- src/dune_engine/process.ml | 35 ++++++--------------------- src/dune_engine/process.mli | 2 -- src/dune_util/report_error.ml | 13 ++++++++++ src/dune_util/report_error.mli | 2 ++ 6 files changed, 30 insertions(+), 33 deletions(-) diff --git a/src/dune_engine/action_runner.ml b/src/dune_engine/action_runner.ml index 4e9d93cf4c7..20e9ff3a822 100644 --- a/src/dune_engine/action_runner.ml +++ b/src/dune_engine/action_runner.ml @@ -70,7 +70,10 @@ end = struct let annots = match with_directory with | Some annot -> - User_message.Annots.set annots Process.with_directory_annot annot + User_message.Annots.set + annots + Dune_util.Report_error.with_directory_annot + annot | None -> annots in User @@ -108,7 +111,7 @@ end = struct 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 + User_message.Annots.find annots Dune_util.Report_error.with_directory_annot in User_with_annots { message diff --git a/src/dune_engine/build_system_error.ml b/src/dune_engine/build_system_error.ml index f34f83398b4..f49c1308df7 100644 --- a/src/dune_engine/build_system_error.ml +++ b/src/dune_engine/build_system_error.ml @@ -27,7 +27,9 @@ 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 = + User_message.Annots.find main.annots Dune_util.Report_error.with_directory_annot + 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 dc85d9052b1..a3a95a5dc54 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 @@ -488,7 +484,6 @@ module Handle_exit_status : sig -> output:string -> command_line:User_message.Style.t Pp.t -> dir:Path.t option - -> context:string option -> 'a val non_verbose @@ -501,7 +496,6 @@ module Handle_exit_status : sig -> dir:Path.t option -> has_unexpected_stdout:bool -> has_unexpected_stderr:bool - -> context:string option -> 'a end = struct open Exit_status @@ -534,7 +528,9 @@ end = struct let get_loc_and_annots ~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 = + User_message.Annots.set annots Dune_util.Report_error.with_directory_annot dir + in let annots = match output with | No_output -> annots @@ -552,14 +548,14 @@ end = struct loc, annots ;; - let fail ~loc ~annots ~context paragraphs = + let fail ~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 ?context paragraphs)) + raise (User_error.E (User_message.make ?loc ~annots paragraphs)) ;; - let verbose t ~id ~metadata ~output ~command_line ~dir ~context = + let verbose t ~id ~metadata ~output ~command_line ~dir = let open Pp.O in let output = parse_output output in match t with @@ -585,7 +581,6 @@ end = struct fail ~loc ~annots - ~context ((Pp.tag User_message.Style.Kwd (Pp.verbatim "Command") ++ Pp.space ++ pp_id id @@ -606,7 +601,6 @@ end = struct ~dir ~has_unexpected_stdout ~has_unexpected_stderr - ~context = let output = parse_output output in let show_command = @@ -662,7 +656,7 @@ end = struct | Signaled signame -> [ Pp.textf "Command got signal %s." (Signal.name signame) ])) in - fail ~loc ~annots ~context paragraphs + fail ~loc ~annots paragraphs ;; end @@ -990,18 +984,6 @@ let run_internal | None -> dir | Some p -> if Path.is_root p then None else Some p in - let context = - let build_context = - match dir with - | None -> None - | Some path -> - (match Path.as_in_build_dir path with - | None -> None - | Some path -> Build_context.of_build_path path) - in - Option.map build_context ~f:(fun build_context -> - Context_name.to_string build_context.name) - in let id = Running_jobs.Id.gen () in let prog_str = Path.reach_for_running ?from:dir prog in let command_line = @@ -1016,7 +998,6 @@ let run_internal in Console.print_user_message (User_message.make - ?context [ Pp.tag User_message.Style.Kwd (Pp.verbatim "Running") ++ pp_id id ++ Pp.verbatim ": " @@ -1087,7 +1068,6 @@ let run_internal ~dir ~command_line:fancy_command_line ~output - ~context | _ -> Handle_exit_status.non_verbose result.exit_status @@ -1099,7 +1079,6 @@ let run_internal ~verbosity:display ~has_unexpected_stdout:result.stdout.unexpected_output ~has_unexpected_stderr:result.stderr.unexpected_output - ~context in Result.close result; res, times) 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..1df4654fa09 100644 --- a/src/dune_util/report_error.ml +++ b/src/dune_util/report_error.ml @@ -14,6 +14,10 @@ type error = ; needs_stack_trace : bool } +let with_directory_annot = + User_message.Annots.Key.create ~name:"with-directory" Path.to_dyn +;; + let code_error ~loc ~dyn_without_loc = let open Pp.O in { responsible = Developer @@ -63,6 +67,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 dir = User_message.Annots.find msg.annots with_directory_annot in + let msg = + match dir with + | None -> msg + | Some path -> + (match Path.extract_build_context path 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/src/dune_util/report_error.mli b/src/dune_util/report_error.mli index 50b65ac8fd2..0f1b00251ce 100644 --- a/src/dune_util/report_error.mli +++ b/src/dune_util/report_error.mli @@ -24,3 +24,5 @@ val print_memo_stacks : bool ref (** Format a list of Memo stack frames into a user-friendly presentation *) val format_memo_stack : 'a Pp.t list -> 'a Pp.t option + +val with_directory_annot : Path.t User_message.Annots.Key.t From cfb02e6d745f15bedbed87e6c1518faff407507c Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Javier=20Ch=C3=A1varri?= Date: Fri, 12 Apr 2024 10:03:29 +0000 Subject: [PATCH 5/8] +changelog MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Signed-off-by: Javier Chávarri --- doc/changes/10414.md | 2 ++ 1 file changed, 2 insertions(+) create mode 100644 doc/changes/10414.md 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) From ed7ce383a7f9b01ede180390e5d79ae8b94c2a9f Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Javier=20Ch=C3=A1varri?= Date: Fri, 12 Apr 2024 10:34:44 +0000 Subject: [PATCH 6/8] exclude .sandbox from logged contexts MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Signed-off-by: Javier Chávarri --- otherlibs/stdune/src/user_message.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/otherlibs/stdune/src/user_message.ml b/otherlibs/stdune/src/user_message.ml index b79be8ab00c..e4ed3308044 100644 --- a/otherlibs/stdune/src/user_message.ml +++ b/otherlibs/stdune/src/user_message.ml @@ -229,7 +229,7 @@ let pp { loc; paragraphs; hints; annots = _; context } = in let paragraphs = match context with - | None | Some "default" -> paragraphs + | None | Some "default" | Some ".sandbox" -> paragraphs | Some context -> Pp.box (Pp.tag Style.Loc (Pp.textf "Context: %s" context)) :: paragraphs in From 550d20e5f33efdc58ff238cca727927ea30321db Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Javier=20Ch=C3=A1varri?= Date: Mon, 6 May 2024 15:04:19 +0000 Subject: [PATCH 7/8] move dir annot to new field in User_message MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit as requested in https://github.com/ocaml/dune/pull/10414#issuecomment-2094281469 Signed-off-by: Javier Chávarri --- otherlibs/stdune/src/user_message.ml | 9 +++++---- otherlibs/stdune/src/user_message.mli | 2 ++ src/dune_console/dune_console.ml | 1 + src/dune_engine/action_runner.ml | 16 +++------------- src/dune_engine/build_system_error.ml | 4 +--- src/dune_engine/process.ml | 3 --- src/dune_util/report_error.ml | 10 +++------- src/dune_util/report_error.mli | 2 -- 8 files changed, 15 insertions(+), 32 deletions(-) diff --git a/otherlibs/stdune/src/user_message.ml b/otherlibs/stdune/src/user_message.ml index e4ed3308044..559228fc644 100644 --- a/otherlibs/stdune/src/user_message.ml +++ b/otherlibs/stdune/src/user_message.ml @@ -174,9 +174,10 @@ type t = ; hints : Style.t Pp.t list ; annots : Annots.t ; context : string option + ; dir : string option } -let compare { loc; paragraphs; hints; annots; context = _ } 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 @@ -186,17 +187,17 @@ let compare { loc; paragraphs; hints; annots; context = _ } t = let equal a b = Ordering.is_eq (compare a b) -let make ?loc ?prefix ?(hints = []) ?(annots = Annots.empty) ?context 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; context } + { loc; hints; paragraphs; annots; context; dir } ;; -let pp { loc; paragraphs; hints; annots = _; context } = +let pp { loc; paragraphs; hints; annots = _; context; dir = _ } = let open Pp.O in let paragraphs = match hints with diff --git a/otherlibs/stdune/src/user_message.mli b/otherlibs/stdune/src/user_message.mli index 363b41e309f..854f4e5a8f7 100644 --- a/otherlibs/stdune/src/user_message.mli +++ b/otherlibs/stdune/src/user_message.mli @@ -67,6 +67,7 @@ type t = ; hints : Style.t Pp.t list ; annots : Annots.t ; context : string option + ; dir : string option } val compare : t -> t -> Ordering.t @@ -92,6 +93,7 @@ val make -> ?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 f1828af185f..ce93f399cb8 100644 --- a/src/dune_console/dune_console.ml +++ b/src/dune_console/dune_console.ml @@ -31,6 +31,7 @@ let blank_line_msg = ; 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 20e9ff3a822..dc85d275229 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,21 +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 - Dune_util.Report_error.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 @@ -110,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 Dune_util.Report_error.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 f49c1308df7..f029a882528 100644 --- a/src/dune_engine/build_system_error.ml +++ b/src/dune_engine/build_system_error.ml @@ -27,9 +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 Dune_util.Report_error.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 a3a95a5dc54..3f308354768 100644 --- a/src/dune_engine/process.ml +++ b/src/dune_engine/process.ml @@ -528,9 +528,6 @@ end = struct let get_loc_and_annots ~dir ~metadata ~output = let { loc; annots; _ } = metadata in let dir = Option.value dir ~default:Path.root in - let annots = - User_message.Annots.set annots Dune_util.Report_error.with_directory_annot dir - in let annots = match output with | No_output -> annots diff --git a/src/dune_util/report_error.ml b/src/dune_util/report_error.ml index 1df4654fa09..d30d1f164a3 100644 --- a/src/dune_util/report_error.ml +++ b/src/dune_util/report_error.ml @@ -14,10 +14,6 @@ type error = ; needs_stack_trace : bool } -let with_directory_annot = - User_message.Annots.Key.create ~name:"with-directory" Path.to_dyn -;; - let code_error ~loc ~dyn_without_loc = let open Pp.O in { responsible = Developer @@ -67,12 +63,12 @@ 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 dir = User_message.Annots.find msg.annots with_directory_annot in let msg = - match dir with + match msg.dir with | None -> msg | Some path -> - (match Path.extract_build_context path with + 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 diff --git a/src/dune_util/report_error.mli b/src/dune_util/report_error.mli index 0f1b00251ce..50b65ac8fd2 100644 --- a/src/dune_util/report_error.mli +++ b/src/dune_util/report_error.mli @@ -24,5 +24,3 @@ val print_memo_stacks : bool ref (** Format a list of Memo stack frames into a user-friendly presentation *) val format_memo_stack : 'a Pp.t list -> 'a Pp.t option - -val with_directory_annot : Path.t User_message.Annots.Key.t From 9a6e0b4ff342c7ac115f48c3a3f948f1cd85c1f1 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Javier=20Ch=C3=A1varri?= Date: Mon, 6 May 2024 15:41:18 +0000 Subject: [PATCH 8/8] pass dir on fail MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Signed-off-by: Javier Chávarri --- src/dune_engine/process.ml | 16 +++++++++------- 1 file changed, 9 insertions(+), 7 deletions(-) diff --git a/src/dune_engine/process.ml b/src/dune_engine/process.ml index 3f308354768..a1ddca60a0d 100644 --- a/src/dune_engine/process.ml +++ b/src/dune_engine/process.ml @@ -525,7 +525,7 @@ 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 = @@ -542,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 = @@ -574,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") @@ -630,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 -> @@ -653,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