From a4d6daae6c42f280e115fcded5b310fd4806a949 Mon Sep 17 00:00:00 2001 From: Ali Caglayan Date: Sat, 26 Aug 2023 17:10:22 +0100 Subject: [PATCH] test: serialize and deserialize RPC error messages (#8411) We demonstrate a bug with how error messages are serialized. Currently there are two "Error:" prefixes after serializing and deserializing. This is because the prefix hasn't been stripped in the initial serialization. We should strip the prefix since the severity information is recorded elsewhere in the diagnostic data. Signed-off-by: Ali Caglayan --- otherlibs/stdune/src/stdune.ml | 26 ++ otherlibs/stdune/src/user_message.ml | 17 ++ otherlibs/stdune/src/user_message.mli | 1 + src/dune_engine/build_system.ml | 9 + src/dune_engine/build_system.mli | 13 + src/dune_rpc_impl/dune_rpc_impl.ml | 6 + test/expect-tests/dune_rpc_impl/dune | 22 ++ .../dune_rpc_impl/dune_rpc_impl_tests.ml | 257 ++++++++++++++++++ 8 files changed, 351 insertions(+) create mode 100644 test/expect-tests/dune_rpc_impl/dune create mode 100644 test/expect-tests/dune_rpc_impl/dune_rpc_impl_tests.ml diff --git a/otherlibs/stdune/src/stdune.ml b/otherlibs/stdune/src/stdune.ml index 8228003bf74..6ae63cd37e3 100644 --- a/otherlibs/stdune/src/stdune.ml +++ b/otherlibs/stdune/src/stdune.ml @@ -30,6 +30,32 @@ module Pp = struct let compare ~compare x y = Ordering.of_int (Pp.compare (fun a b -> Ordering.to_int (compare a b)) x y) ;; + + let to_dyn tag_to_dyn t = + match Pp.to_ast t with + | Error _ -> Dyn.variant "Contains Format" [ Dyn.opaque "" ] + | Ok t -> + let open Dyn in + let rec to_dyn t = + match (t : _ Pp.Ast.t) with + | Nop -> variant "Nop" [] + | Seq (x, y) -> variant "Seq" [ to_dyn x; to_dyn y ] + | Concat (x, y) -> variant "Concat" [ to_dyn x; list to_dyn y ] + | Box (i, t) -> variant "Box" [ int i; to_dyn t ] + | Vbox (i, t) -> variant "Vbox" [ int i; to_dyn t ] + | Hbox t -> variant "Hbox" [ to_dyn t ] + | Hvbox (i, t) -> variant "Hvbox" [ int i; to_dyn t ] + | Hovbox (i, t) -> variant "Hovbox" [ int i; to_dyn t ] + | Verbatim s -> variant "Verbatim" [ string s ] + | Char c -> variant "Char" [ char c ] + | Break (x, y) -> + variant "Break" [ triple string int string x; triple string int string y ] + | Newline -> variant "Newline" [] + | Text s -> variant "Text" [ string s ] + | Tag (s, t) -> variant "Tag" [ tag_to_dyn s; to_dyn t ] + in + to_dyn t + ;; end module Result = Result diff --git a/otherlibs/stdune/src/user_message.ml b/otherlibs/stdune/src/user_message.ml index c6ed4cd9248..f72e31973bf 100644 --- a/otherlibs/stdune/src/user_message.ml +++ b/otherlibs/stdune/src/user_message.ml @@ -13,6 +13,23 @@ module Style = struct | Success | Ansi_styles of Ansi_color.Style.t list + let to_dyn = + let open Dyn in + function + | Loc -> variant "Loc" [] + | Error -> variant "Error" [] + | Warning -> variant "Warning" [] + | Kwd -> variant "Kwd" [] + | Id -> variant "Id" [] + | Prompt -> variant "Prompt" [] + | Hint -> variant "Hint" [] + | Details -> variant "Details" [] + | Ok -> variant "Ok" [] + | Debug -> variant "Debug" [] + | Success -> variant "Success" [] + | Ansi_styles l -> variant "Ansi_styles" [ list Ansi_color.Style.to_dyn l ] + ;; + let compare t1 t2 : Ordering.t = match t1, t2 with | Loc, Loc -> Eq diff --git a/otherlibs/stdune/src/user_message.mli b/otherlibs/stdune/src/user_message.mli index 64ba91b2dd9..c618d801e24 100644 --- a/otherlibs/stdune/src/user_message.mli +++ b/otherlibs/stdune/src/user_message.mli @@ -22,6 +22,7 @@ module Style : sig | Success | Ansi_styles of Ansi_color.Style.t list + val to_dyn : t -> Dyn.t val compare : t -> t -> Ordering.t end diff --git a/src/dune_engine/build_system.ml b/src/dune_engine/build_system.ml index 8b59841ee04..11532a06062 100644 --- a/src/dune_engine/build_system.ml +++ b/src/dune_engine/build_system.ml @@ -92,6 +92,15 @@ module Error = struct | Diagnostic d -> `Diagnostic d.diagnostic ;; + module For_tests = struct + let make ~description ~dir ~promotion () = + let id = Id.gen () in + match description with + | `Exn exn -> Exn { id; exn } + | `Diagnostic diagnostic -> Diagnostic { id; diagnostic; dir; promotion } + ;; + end + module Set : sig type error := t diff --git a/src/dune_engine/build_system.mli b/src/dune_engine/build_system.mli index c86e939d053..eca27f9df71 100644 --- a/src/dune_engine/build_system.mli +++ b/src/dune_engine/build_system.mli @@ -126,6 +126,19 @@ module Error : sig val current : t -> error Id.Map.t val empty : t end + + module For_tests : sig + (** Internal helpers for testing purposes. Do not use. *) + + (** Construct an [Error.t] *) + val make + : description: + [ `Exn of Exn_with_backtrace.t | `Diagnostic of Compound_user_error.t ] + -> dir:Path.t option + -> promotion:Diff_promotion.Annot.t option + -> unit + -> t + end end (** The current set of active errors. *) diff --git a/src/dune_rpc_impl/dune_rpc_impl.ml b/src/dune_rpc_impl/dune_rpc_impl.ml index a6eb06bdde2..c685ca91857 100644 --- a/src/dune_rpc_impl/dune_rpc_impl.ml +++ b/src/dune_rpc_impl/dune_rpc_impl.ml @@ -6,6 +6,12 @@ module Private = Dune_rpc_client.Private module Watch_mode_config = Watch_mode_config module Where = Dune_rpc_client.Where +module Diagnostics = struct + module For_tests = struct + let diagnostic_of_error = Diagnostics.diagnostic_of_error + end +end + module Poll_active = Dune_rpc_private.Registry.Poll (Fiber) diff --git a/test/expect-tests/dune_rpc_impl/dune b/test/expect-tests/dune_rpc_impl/dune new file mode 100644 index 00000000000..e6c9bc91c36 --- /dev/null +++ b/test/expect-tests/dune_rpc_impl/dune @@ -0,0 +1,22 @@ +(library + (name dune_rpc_impl_tests) + (modules dune_rpc_impl_tests) + (inline_tests) + (libraries + ; ocaml_config + ; dune_util + dune_console + dune_rpc_private + dune_rpc_impl + dune_engine + dune_re + stdune + ;; This is because of the (implicit_transitive_deps false) + ;; in dune-project + ppx_expect.config + ppx_expect.config_types + ppx_expect.common + base + ppx_inline_test.config) + (preprocess + (pps ppx_expect))) diff --git a/test/expect-tests/dune_rpc_impl/dune_rpc_impl_tests.ml b/test/expect-tests/dune_rpc_impl/dune_rpc_impl_tests.ml new file mode 100644 index 00000000000..1d172662600 --- /dev/null +++ b/test/expect-tests/dune_rpc_impl/dune_rpc_impl_tests.ml @@ -0,0 +1,257 @@ +open Stdune +module Dune_rpc = Dune_rpc_private +module Re = Dune_re + +let () = + Stdune.Path.set_root (Stdune.Path.External.of_filename_relative_to_initial_cwd "."); + Stdune.Path.Build.set_build_dir (Stdune.Path.Outside_build_dir.of_string "_build") +;; + +let test ~dir ~f main = + let description = + `Diagnostic (Dune_engine.Compound_user_error.make ~main ~related:[]) + in + Dune_console.printf "---- Original ----"; + f main; + Dune_console.printf "------- RPC ------"; + Dune_engine.Build_system.Error.For_tests.make ~description ~dir ~promotion:None () + |> Dune_rpc_impl.Diagnostics.For_tests.diagnostic_of_error + |> Dune_rpc_private.Diagnostic.to_user_message + |> f +;; + +let test_plain ~dir main = test main ~dir ~f:Dune_console.print_user_message + +let test_dyn ~dir main = + test main ~dir ~f:(fun x -> + Stdune.User_message.pp x + |> Pp.to_dyn Stdune.User_message.Style.to_dyn + |> Dyn.to_string + |> print_endline) +;; + +let scrub output = + Re.replace_string + (Re.compile (Re.str Stdune.Path.(to_absolute_filename root))) + ~by:"TEST" + output + |> print_endline +;; + +let%expect_test "serialize and deserialize error message" = + let dir = None in + let message = User_error.make [ Pp.verbatim "Oh no!" ] in + test_plain ~dir message; + test_dyn ~dir message; + [%expect + {| + ---- Original ---- + Error: Oh no! + ------- RPC ------ + Error: Error: Oh no! + ---- Original ---- + Vbox + 0,Seq + Box + 0,Concat + Break ("", 1, ""),("", 0, ""),[ Seq + Tag Error,Verbatim "Error", + Char + : + ; Verbatim "Oh no!" + ],Break ("", 0, ""),("", 0, "") + ------- RPC ------ + Vbox + 0,Seq + Box + 0,Concat + Break ("", 1, ""),("", 0, ""),[ Tag Error,Text "Error:" + ; Concat + Break ("", 1, ""),("", 0, ""), + [ Seq + Tag + Details,Verbatim "Error", + Char + : + ; Verbatim "Oh no!" + ] + ],Break ("", 0, ""),("", 0, "") |}] +;; + +let%expect_test "serialize and deserialize error message with location" = + let loc = Stdune.Loc.of_pos ("Bar", 1, 2, 3) in + let dir = Some (Stdune.Path.of_string "/Foo") in + let message = User_error.make ~loc [ Pp.verbatim "An error with location!" ] in + test_plain ~dir message; + test_dyn ~dir message; + [%expect + {| + ---- Original ---- + File "Bar", line 1, characters 2-3: + Error: An error with location! + ------- RPC ------ + Error: (In directory /Foo) + File "/Foo/Bar", line 1, characters 2-3: + + Error: An error with location! + ---- Original ---- + Vbox + 0,Concat + Nop,[ Seq + Box 0,Tag Loc,Text "File \"Bar\", line 1, characters 2-3:", + Break + ("", 0, ""),("", 0, "") + ; Seq + Box + 0,Concat + Break ("", 1, ""),("", 0, ""),[ Seq + Tag + Error,Verbatim + "Error", + Char + : + ; Verbatim + "An error with location!" + ],Break + ("", 0, ""),("", 0, "") + ] + ------- RPC ------ + Vbox + 0,Concat + Nop,[ Seq + Box + 0,Concat + Break ("", 1, ""),("", 0, ""),[ Tag Error,Text "Error:" + ; Tag + Loc,Text + "(In directory /Foo)" + ],Break + ("", 0, ""),("", 0, "") + ; Seq + Box + 0,Seq + Seq + Tag + Loc,Verbatim + "File \"/Foo/Bar\", line 1, characters 2-3:",Newline,Nop, + Break + ("", 0, ""),("", 0, "") + ; Seq + Box + 0,Concat + Break ("", 1, ""),("", 0, ""),[ Seq + Tag + Details,Verbatim + "Error", + Char + : + ; Verbatim + "An error with location!" + ],Break + ("", 0, ""),("", 0, "") + ] |}] +;; + +let%expect_test "serialize and deserialize error with location exerpt and hint" = + Io.String_path.write_file "foo.ml" "let x = 1\nlet y = 2\nlet z = 3\n"; + let loc = Stdune.Loc.of_pos ("foo.ml", 1, 2, 3) in + let dir = Some (Stdune.Path.of_string ".") in + let hints = [ Pp.verbatim "Hint 1"; Pp.verbatim "Hint 2" ] in + let message = User_error.make ~loc ~hints [ Pp.verbatim "An error with location!" ] in + test_plain ~dir message; + test_dyn ~dir message; + scrub [%expect.output]; + [%expect + {| + ---- Original ---- + File "foo.ml", line 1, characters 2-3: + 1 | let x = 1 + ^ + Error: An error with location! + Hint: Hint 1 + Hint: Hint 2 + ------- RPC ------ + Error: (In directory + TEST) + File "TEST/foo.ml", line 1, characters 2-3: + 1 | let x = 1 + ^ + + Error: An error with location! + ---- Original ---- + Vbox + 0,Concat + Nop,[ Seq + Box 0,Tag Loc,Text "File \"foo.ml\", line 1, characters 2-3:", + Break + ("", 0, ""),("", 0, "") + ; Seq + Box + 0,Concat + Break ("", 1, ""),("", 0, ""),[ Seq + Tag + Error,Verbatim + "Error", + Char + : + ; Verbatim + "An error with location!" + ],Break + ("", 0, ""),("", 0, "") + ; Seq + Box + 0,Seq + Seq + Tag Hint,Verbatim "Hint:",Break ("", 1, ""),("", 0, ""), + Verbatim + "Hint 1",Break ("", 0, ""),("", 0, "") + ; Seq + Box + 0,Seq + Seq + Tag Hint,Verbatim "Hint:",Break ("", 1, ""),("", 0, ""), + Verbatim + "Hint 2",Break ("", 0, ""),("", 0, "") + ] + ------- RPC ------ + Vbox + 0,Concat + Nop,[ Seq + Box + 0,Concat + Break ("", 1, ""),("", 0, ""),[ Tag Error,Text "Error:" + ; Tag + Loc,Text + "(In directory TEST)" + ],Break + ("", 0, ""),("", 0, "") + ; Seq + Box + 0,Seq + Seq + Tag + Loc,Verbatim + "File \"TEST/foo.ml\", line 1, characters 2-3:",Newline, + Seq + Seq + Seq + Seq + Seq Verbatim "1",Verbatim " | ",Verbatim + "let x = 1",Newline, + Verbatim + " ^",Newline,Break ("", 0, ""),("", 0, "") + ; Seq + Box + 0,Concat + Break ("", 1, ""),("", 0, ""),[ Seq + Tag + Details,Verbatim + "Error", + Char + : + ; Verbatim + "An error with location!" + ],Break + ("", 0, ""),("", 0, "") + ] |}] +;;