test: serialize and reserialize RPC error messages

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 <alizter@gmail.com>

src/dune_engine/build_system.ml

@@ -92,6 +92,14 @@ module Error = struct
     | Diagnostic d -> `Diagnostic d.diagnostic
   ;;
 
+  module For_tests = struct
+    let make ~id ~description ~dir ~promotion () =
+      match description with
+      | `Exn exn -> Exn { id; exn }
+      | `Diagnostic diagnostic -> Diagnostic { id; diagnostic; dir; promotion }
+    ;;
+  end
+
   module Set : sig
     type error := t
 

src/dune_engine/build_system.mli

@@ -88,6 +88,7 @@ module Error : sig
 
     module Map : Map.S with type key = t
 
+    val gen : unit -> t
     val compare : t -> t -> Ordering.t
     val to_int : t -> int
     val to_dyn : t -> Dyn.t
@@ -126,6 +127,20 @@ 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
+      :  id:Id.t
+      -> 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. *)

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)

test/expect-tests/dune_rpc/dune

@@ -5,10 +5,13 @@
  (libraries
   ocaml_config
   dune_util
+  dune_console
   dune_rpc_private
   dune_rpc_server
   dune_rpc_impl
   dune_rpc_client
+  dune_engine
+  dune_re
   stdune
   test_scheduler
   csexp

test/expect-tests/dune_rpc/dune_rpc_tests.ml

@@ -925,3 +925,37 @@ let%expect_test "print digests for all public RPCs" =
       Request: Sexp
       Response: 33528f248084297d123a6ebd4c3ddee0 |}]
 ;;
+
+let () =
+  Stdune.Path.set_root (Stdune.Path.External.of_filename_relative_to_initial_cwd ".")
+;;
+
+let test ?dir ?promotion main =
+  let id = Dune_engine.Build_system.Error.Id.gen () in
+  let description =
+    `Diagnostic (Dune_engine.Compound_user_error.make ~main ~related:[])
+  in
+  Dune_console.printf "---- Original ----";
+  Dune_console.print_user_message main;
+  Dune_console.printf "------- RPC ------";
+  Dune_engine.Build_system.Error.For_tests.make ~id ~description ~dir ~promotion ()
+  |> Dune_rpc_impl.Diagnostics.For_tests.diagnostic_of_error
+  |> Dune_rpc_private.Diagnostic.to_user_message
+  |> Dune_console.print_user_message
+;;
+
+let%expect_test "serialize and deserialize error message with location" =
+  let loc = Stdune.Loc.of_pos ("Bar", 1, 2, 3) in
+  let dir = Stdune.Path.of_string "/Foo" in
+  test ~dir (User_error.make ~loc [ Pp.verbatim "An error with location!" ]);
+  [%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! |}]
+;;