diff --git a/CHANGES.md b/CHANGES.md index 3f18b12224b..287de0b15e4 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -87,6 +87,10 @@ unreleased - Fix generation of `.merlin` whenever there's more than one stanza with the same ppx preprocessing specification (#2209 ,fixes #2206, @rgrinberg) +- Fix generation of `.meriln` in the presence of the `copy_files` stanza and + preprocessing specifications of other stanazs. (#2211, fixes #2206, + @rgrinberg) + 1.9.3 (06/05/2019) ------------------ diff --git a/src/gen_rules.ml b/src/gen_rules.ml index 0edc40ac3da..501625a3182 100644 --- a/src/gen_rules.ml +++ b/src/gen_rules.ml @@ -6,22 +6,25 @@ open Dune_file open! No_io module For_stanza = struct - type ('merlin, 'cctx, 'js) t = + type ('merlin, 'cctx, 'js, 'source_dirs) t = { merlin : 'merlin ; cctx : 'cctx ; js : 'js + ; source_dirs : 'source_dirs } let empty_none = { merlin = None ; cctx = None ; js = None + ; source_dirs = None } let empty_list = { merlin = [] ; cctx = [] ; js = [] + ; source_dirs = [] } let cons_maybe hd_o tl = @@ -32,16 +35,19 @@ module For_stanza = struct let cons acc x = { merlin = cons_maybe x.merlin acc.merlin ; cctx = cons_maybe x.cctx acc.cctx + ; source_dirs = cons_maybe x.source_dirs acc.source_dirs ; js = match x.js with | None -> acc.js | Some js -> List.rev_append acc.js js + } let rev t = { t with merlin = List.rev t.merlin ; cctx = List.rev t.cctx + ; source_dirs = List.rev t.source_dirs } end @@ -85,6 +91,7 @@ module Gen(P : sig val sctx : Super_context.t end) = struct merlin = Some merlin ; cctx = Some (lib.buildable.loc, cctx) ; js = None + ; source_dirs = None } | Executables exes -> let cctx, merlin = @@ -100,6 +107,7 @@ module Gen(P : sig val sctx : Super_context.t end) = struct List.map [exe ^ ".bc.js" ; exe ^ ".bc.runtime.js"] ~f:(Path.Build.relative ctx_dir))) + ; source_dirs = None } | Alias alias -> Simple_rules.alias sctx alias ~dir ~expander; @@ -113,19 +121,20 @@ module Gen(P : sig val sctx : Super_context.t end) = struct merlin = Some merlin ; cctx = Some (tests.exes.buildable.loc, cctx) ; js = None + ; source_dirs = None } | Copy_files { glob; _ } -> - let source_dirs = + let source_dir = let loc = String_with_vars.loc glob in let src_glob = Expander.expand_str expander glob in Path.Source.relative src_dir src_glob ~error_loc:loc |> Path.Source.parent_exn - |> Path.Source.Set.singleton in { For_stanza. - merlin = Some (Merlin.make ~source_dirs ()) + merlin = None ; cctx = None ; js = None + ; source_dirs = Some source_dir } | Install { Install_conf. section = _; files; package = _ } -> List.map files ~f:(fun fb -> @@ -141,6 +150,7 @@ module Gen(P : sig val sctx : Super_context.t end) = struct merlin = merlins ; cctx = cctxs ; js = js_targets + ; source_dirs } = List.fold_left stanzas ~init:{ For_stanza.empty_list with cctx = cctxs } ~f:(fun acc a -> For_stanza.cons acc (for_stanza a)) @@ -152,8 +162,10 @@ module Gen(P : sig val sctx : Super_context.t end) = struct Option.iter (Merlin.merge_all ~allow_approx_merlin merlins) ~f:(fun m -> let more_src_dirs = - List.map (Dir_contents.dirs dir_contents) ~f:(fun dc -> + Dir_contents.dirs dir_contents + |> List.map ~f:(fun dc -> Path.Build.drop_build_context_exn (Dir_contents.dir dc)) + |> List.rev_append source_dirs in Merlin.add_rules sctx ~dir:ctx_dir ~more_src_dirs ~expander ~dir_kind (Merlin.add_source_dir m src_dir)); diff --git a/test/blackbox-tests/dune.inc b/test/blackbox-tests/dune.inc index 2f0eae8667e..29f9daafc72 100644 --- a/test/blackbox-tests/dune.inc +++ b/test/blackbox-tests/dune.inc @@ -659,6 +659,14 @@ test-cases/github2123 (progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected))))) +(alias + (name github2206) + (deps (package dune) (source_tree test-cases/github2206)) + (action + (chdir + test-cases/github2206 + (progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected))))) + (alias (name github24) (deps (package dune) (source_tree test-cases/github24)) @@ -1557,6 +1565,7 @@ (alias github2033) (alias github2061) (alias github2123) + (alias github2206) (alias github24) (alias github25) (alias github534) @@ -1733,6 +1742,7 @@ (alias github2033) (alias github2061) (alias github2123) + (alias github2206) (alias github24) (alias github25) (alias github534) diff --git a/test/blackbox-tests/test-cases/github2206/copy_files/dune b/test/blackbox-tests/test-cases/github2206/copy_files/dune new file mode 100644 index 00000000000..0e99efebf47 --- /dev/null +++ b/test/blackbox-tests/test-cases/github2206/copy_files/dune @@ -0,0 +1,5 @@ +(copy_files sources/*) + +(executable + (name foo) + (preprocess (action (run %{project_root}/pp.exe %{input-file})))) diff --git a/test/blackbox-tests/test-cases/github2206/copy_files/foo.ml b/test/blackbox-tests/test-cases/github2206/copy_files/foo.ml new file mode 100644 index 00000000000..e69de29bb2d diff --git a/test/blackbox-tests/test-cases/github2206/copy_files/sources/foo b/test/blackbox-tests/test-cases/github2206/copy_files/sources/foo new file mode 100644 index 00000000000..e69de29bb2d diff --git a/test/blackbox-tests/test-cases/github2206/dune b/test/blackbox-tests/test-cases/github2206/dune new file mode 100644 index 00000000000..92bc0106c3b --- /dev/null +++ b/test/blackbox-tests/test-cases/github2206/dune @@ -0,0 +1,2 @@ +(executable + (name pp)) diff --git a/test/blackbox-tests/test-cases/github2206/dune-project b/test/blackbox-tests/test-cases/github2206/dune-project new file mode 100644 index 00000000000..eb10bcb833c --- /dev/null +++ b/test/blackbox-tests/test-cases/github2206/dune-project @@ -0,0 +1 @@ +(lang dune 1.10) \ No newline at end of file diff --git a/test/blackbox-tests/test-cases/github2206/pp.ml b/test/blackbox-tests/test-cases/github2206/pp.ml new file mode 100644 index 00000000000..ff7dbe15213 --- /dev/null +++ b/test/blackbox-tests/test-cases/github2206/pp.ml @@ -0,0 +1,7 @@ +let file = Sys.argv.(1) + +let () = + let ch = open_in file in + let s = really_input_string ch (in_channel_length ch) in + close_in_noerr ch; + print_string s diff --git a/test/blackbox-tests/test-cases/github2206/run.t b/test/blackbox-tests/test-cases/github2206/run.t new file mode 100644 index 00000000000..2db2b0f8aff --- /dev/null +++ b/test/blackbox-tests/test-cases/github2206/run.t @@ -0,0 +1,4 @@ +copy_files would break the generation of the preprocessing flags + $ dune build copy_files/.merlin + $ cat copy_files/.merlin | grep "FLG -pp" + FLG -pp '$TESTCASE_ROOT/_build/default/pp.exe'