From a5fe41d983f5757757f9dee9cebc3a2eada50f04 Mon Sep 17 00:00:00 2001 From: Rudi Grinberg Date: Wed, 29 May 2019 15:52:13 +0700 Subject: [PATCH 1/2] Add test case for bug 2206 Signed-off-by: Rudi Grinberg --- test/blackbox-tests/dune.inc | 10 ++++++++++ .../test-cases/github2206/copy_files/dune | 5 +++++ .../test-cases/github2206/copy_files/foo.ml | 0 .../test-cases/github2206/copy_files/sources/foo | 0 test/blackbox-tests/test-cases/github2206/dune | 2 ++ test/blackbox-tests/test-cases/github2206/dune-project | 1 + test/blackbox-tests/test-cases/github2206/pp.ml | 7 +++++++ test/blackbox-tests/test-cases/github2206/run.t | 9 +++++++++ 8 files changed, 34 insertions(+) create mode 100644 test/blackbox-tests/test-cases/github2206/copy_files/dune create mode 100644 test/blackbox-tests/test-cases/github2206/copy_files/foo.ml create mode 100644 test/blackbox-tests/test-cases/github2206/copy_files/sources/foo create mode 100644 test/blackbox-tests/test-cases/github2206/dune create mode 100644 test/blackbox-tests/test-cases/github2206/dune-project create mode 100644 test/blackbox-tests/test-cases/github2206/pp.ml create mode 100644 test/blackbox-tests/test-cases/github2206/run.t 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..1b91c9b88f3 --- /dev/null +++ b/test/blackbox-tests/test-cases/github2206/run.t @@ -0,0 +1,9 @@ +copy_files would break the generation of the preprocessing flags + $ dune build copy_files/.merlin + File "copy_files/dune", line 5, characters 21-63: + 5 | (preprocess (action (run %{project_root}/pp.exe %{input-file})))) + ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ + Warning: .merlin generated is inaccurate. Cannot mix preprocessed and non preprocessed specificiations. + Split the stanzas into different directories or silence this warning by adding (allow_approximate_merlin) to your dune-project. + $ cat copy_files/.merlin | grep "FLG -pp" + [1] From 634a73bf919ec96b7af99fcaffa3264a02edd43f Mon Sep 17 00:00:00 2001 From: Rudi Grinberg Date: Wed, 29 May 2019 12:26:08 +0700 Subject: [PATCH 2/2] Fix copy_files handling when generating .merlin files Merlin generation would be broken in the presence of copy_files and any other stanza with a preprocessing directive. This is because copy_files would have No_preprocessing, and that would only successfully merge with non preprocessing stanzas. To fix the problem, we no longer rely on merging mechanism to add additional directories for copy_files, the more_src_dirs argument aready exists for that. Signed-off-by: Rudi Grinberg --- CHANGES.md | 4 ++++ src/gen_rules.ml | 22 ++++++++++++++----- .../test-cases/github2206/run.t | 7 +----- 3 files changed, 22 insertions(+), 11 deletions(-) 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/test-cases/github2206/run.t b/test/blackbox-tests/test-cases/github2206/run.t index 1b91c9b88f3..2db2b0f8aff 100644 --- a/test/blackbox-tests/test-cases/github2206/run.t +++ b/test/blackbox-tests/test-cases/github2206/run.t @@ -1,9 +1,4 @@ copy_files would break the generation of the preprocessing flags $ dune build copy_files/.merlin - File "copy_files/dune", line 5, characters 21-63: - 5 | (preprocess (action (run %{project_root}/pp.exe %{input-file})))) - ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ - Warning: .merlin generated is inaccurate. Cannot mix preprocessed and non preprocessed specificiations. - Split the stanzas into different directories or silence this warning by adding (allow_approximate_merlin) to your dune-project. $ cat copy_files/.merlin | grep "FLG -pp" - [1] + FLG -pp '$TESTCASE_ROOT/_build/default/pp.exe'