diff --git a/src/dune_rules/module.ml b/src/dune_rules/module.ml index ada39d63387..ebaf4efbcc7 100644 --- a/src/dune_rules/module.ml +++ b/src/dune_rules/module.ml @@ -336,6 +336,15 @@ let sources_without_pp t = ~f:(Option.map ~f:(fun (x : File.t) -> x.original_path)) ;; +let source_without_pp ~ml_kind t = + let source = + match (ml_kind : Ml_kind.t) with + | Impl -> t.source.files.impl + | Intf -> t.source.files.intf + in + Option.map source ~f:(fun (x : File.t) -> x.original_path) +;; + module Obj_map = struct include Map.Make (struct type nonrec t = t diff --git a/src/dune_rules/module.mli b/src/dune_rules/module.mli index b95cf62cbc6..fe095bb12e5 100644 --- a/src/dune_rules/module.mli +++ b/src/dune_rules/module.mli @@ -88,6 +88,7 @@ end val sources : t -> Path.t list val sources_without_pp : t -> Path.t list +val source_without_pp : ml_kind:Ml_kind.t -> t -> Path.t option val visibility : t -> Visibility.t val encode : t -> src_dir:Path.t -> Dune_lang.t list val decode : src_dir:Path.t -> t Dune_lang.Decoder.t diff --git a/src/dune_rules/module_compilation.ml b/src/dune_rules/module_compilation.ml index ac1780467e2..91e8cc0f3c2 100644 --- a/src/dune_rules/module_compilation.ml +++ b/src/dune_rules/module_compilation.ml @@ -158,6 +158,7 @@ let build_cm let* compiler = compiler in let ml_kind = Lib_mode.Cm_kind.source cm_kind in let+ src = Module.file m ~ml_kind in + let original = Module.source_without_pp m ~ml_kind in let dst = Obj_dir.Module.cm_file_exn obj_dir m ~kind:cm_kind in let obj = Obj_dir.Module.obj_file obj_dir m ~kind:(Ocaml Cmx) ~ext:ocaml.lib_config.ext_obj @@ -324,6 +325,10 @@ let build_cm ; A "-c" ; Command.Ml_kind.flag ml_kind ; Dep src + ; (* We add a hidden dependency on the original, pre-PPX source + file, which the compiler wants to find to display error + location snippets. *) + Hidden_deps (Dep.Set.of_files (Option.to_list original)) ; other_targets ] >>| Action.Full.add_sandbox sandbox)) diff --git a/test/blackbox-tests/test-cases/melange/ppx-preview.t b/test/blackbox-tests/test-cases/melange/ppx-preview.t index 5a7d7daa994..f1831957885 100644 --- a/test/blackbox-tests/test-cases/melange/ppx-preview.t +++ b/test/blackbox-tests/test-cases/melange/ppx-preview.t @@ -15,26 +15,41 @@ Show PPX snippet preview is shown in Dune > let x: nope = "hello" > EOF - $ cat > dune < (melange.emit - > (target output) - > (libraries the_lib) - > (emit_stdlib false)) - > EOF - $ export DUNE_SANDBOX=symlink - $ dune build @melange + $ dune build @all File "lib/the_lib.ml", line 1, characters 7-11: + 1 | let x: nope = "hello" + ^^^^ Error: Unbound type constructor nope [1] Works if the sandbox is disabled $ export DUNE_SANDBOX=none - $ dune build @melange + $ dune build @all File "lib/the_lib.ml", line 1, characters 7-11: 1 | let x: nope = "hello" ^^^^ Error: Unbound type constructor nope [1] + $ cat > lib/the_lib.mli < val x: nope + > EOF + + $ export DUNE_SANDBOX=symlink + $ dune build @all + File "lib/the_lib.mli", line 1, characters 7-11: + 1 | val x: nope + ^^^^ + Error: Unbound type constructor nope + [1] + + $ export DUNE_SANDBOX=none + $ dune build @all + File "lib/the_lib.mli", line 1, characters 7-11: + 1 | val x: nope + ^^^^ + Error: Unbound type constructor nope + [1] +