test(melange): show crash when melange.emit depends on transitive PPX

src/dune_rules/melange/melange_rules.ml

@@ -469,7 +469,6 @@ let setup_emit_js_rules ~dir_contents ~dir ~scope ~sctx mel =
     let* modules_for_js, _obj_dir =
       modules_for_js_and_obj_dir ~sctx ~dir_contents ~scope mel
     in
-    Resolve.push_frames resolve_error @@ fun () ->
     let module_systems = mel.module_systems in
     let output = `Private_library_or_emit target_dir in
     let loc = mel.loc in
@@ -478,5 +477,8 @@ let setup_emit_js_rules ~dir_contents ~dir ~scope ~sctx mel =
             let file_targets = [ make_js_name ~output ~js_ext m ] in
             Super_context.add_rule sctx ~dir ~loc ~mode
               (Action_builder.fail
-                 { fail = (fun () -> Resolve.raise_error resolve_error) }
+                 { fail =
+                     (fun () ->
+                       Resolve.raise_error_with_stack_trace resolve_error)
+                 }
               |> Action_builder.with_file_targets ~file_targets)))

src/dune_rules/resolve.ml

@@ -54,9 +54,20 @@ let push_frames { stack_frames; message = _ } f =
   in
   loop stack_frames
 
-let raise_error { message; _ } = raise (User_error.E message)
-
-let error_to_memo error = push_frames error (fun () -> raise_error error)
+let error_to_memo error =
+  push_frames error (fun () -> raise (User_error.E error.message))
+
+let raise_error_with_stack_trace { message; stack_frames } =
+  match
+    Dune_util.Report_error.format_memo_stack
+      (List.map stack_frames ~f:Lazy.force)
+  with
+  | None -> raise (User_error.E message)
+  | Some stack ->
+    let message =
+      { message with paragraphs = message.paragraphs @ [ stack ] }
+    in
+    raise (User_error.E message)
 
 let read_memo = function
   | Ok x -> Memo.return x

src/dune_rules/resolve.mli

@@ -108,9 +108,7 @@ type error
 
 val to_result : 'a t -> ('a, error) result
 
-val raise_error : error -> 'a
-
-val push_frames : error -> (unit -> 'a Memo.t) -> 'a Memo.t
+val raise_error_with_stack_trace : error -> 'a
 
 (** Read a [Resolve.t] value inside the action builder monad. *)
 val read : 'a t -> 'a Action_builder.t

src/dune_util/report_error.mli

@@ -22,3 +22,6 @@ exception Already_reported
 
 (** Print the memo stacks of errors. *)
 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

test/blackbox-tests/test-cases/melange/transitive-ppx.t

@@ -0,0 +1,49 @@
+Test interaction of melange.emit library ppx dependencies
+
+  $ mkdir lib test ppx
+  $ cat > dune-project <<EOF
+  > (lang dune 3.8)
+  > (package (name mel-subdir))
+  > (using melange 0.1)
+  > EOF
+
+  $ mkdir lib/test
+  $ touch lib/dune
+
+  $ mkdir lib/impl
+  $ cat > lib/impl/dune <<EOF
+  > (library
+  >  (name subdir)
+  >  (modes melange)
+  >  (public_name mel-subdir)
+  >  (preprocess (pps not-present)))
+  > EOF
+  $ touch lib/impl/subdir.ml
+
+  $ cat > lib/test/dune <<EOF
+  > (melange.emit
+  >  (target dist)
+  >  (emit_stdlib false)
+  >  (modules)
+  >  (libraries subdir))
+  > EOF
+
+  $ dune build
+  File "lib/impl/dune", line 5, characters 18-29:
+  5 |  (preprocess (pps not-present)))
+                        ^^^^^^^^^^^
+  Error: Library "not-present" not found.
+  -> required by library "mel-subdir" in _build/default/lib/impl
+  -> required by melange target dist
+  -> required by alias lib/test/all
+  -> required by alias default
+  File "lib/impl/dune", line 5, characters 18-29:
+  5 |  (preprocess (pps not-present)))
+                        ^^^^^^^^^^^
+  Error: Library "not-present" not found.
+  -> required by melange target dist
+  -> required by library "mel-subdir" in _build/default/lib/impl
+  -> required by _build/default/lib/test/dist/lib/test/.dist.mobjs/melange.js
+  -> required by alias lib/test/all
+  -> required by alias default
+  [1]