From a0a37c8f54fd9173ede4102de5f86ebbc6adc8ea Mon Sep 17 00:00:00 2001 From: Jeremie Dimino Date: Tue, 3 Dec 2019 08:29:01 +0000 Subject: [PATCH 1/2] Add reproduction case for #2927 Signed-off-by: Jeremie Dimino --- test/blackbox-tests/dune.inc | 12 ++++++++++++ .../dune-project-meta/github2927/run.t | 16 ++++++++++++++++ 2 files changed, 28 insertions(+) create mode 100644 test/blackbox-tests/test-cases/dune-project-meta/github2927/run.t diff --git a/test/blackbox-tests/dune.inc b/test/blackbox-tests/dune.inc index 6f7b3602ef7..083954266b1 100644 --- a/test/blackbox-tests/dune.inc +++ b/test/blackbox-tests/dune.inc @@ -511,6 +511,16 @@ (run %{exe:cram.exe} run.t -sanitizer %{bin:sanitizer}) (diff? run.t run.t.corrected))))) +(rule + (alias dune-project-meta-github2927) + (deps (package dune) (source_tree test-cases/dune-project-meta/github2927)) + (action + (chdir + test-cases/dune-project-meta/github2927 + (progn + (run %{exe:cram.exe} run.t -sanitizer %{bin:sanitizer}) + (diff? run.t run.t.corrected))))) + (rule (alias dune-project-no-opam) (deps (package dune) (source_tree test-cases/dune-project-no-opam)) @@ -2698,6 +2708,7 @@ (alias dune-ppx-driver-system) (alias dune-project-edition) (alias dune-project-meta) + (alias dune-project-meta-github2927) (alias dune-project-no-opam) (alias dune_memory-and-the-universe) (alias dup-fields) @@ -2953,6 +2964,7 @@ (alias dune-package) (alias dune-project-edition) (alias dune-project-meta) + (alias dune-project-meta-github2927) (alias dune-project-no-opam) (alias dune_memory-and-the-universe) (alias dup-fields) diff --git a/test/blackbox-tests/test-cases/dune-project-meta/github2927/run.t b/test/blackbox-tests/test-cases/dune-project-meta/github2927/run.t new file mode 100644 index 00000000000..8cf5ba29d1f --- /dev/null +++ b/test/blackbox-tests/test-cases/dune-project-meta/github2927/run.t @@ -0,0 +1,16 @@ +Generation of opam files is attached to @all +-------------------------------------------- +Reproduction case for #2927 + + $ mkdir attached-to-all + $ cat >attached-to-all/dune-project < (lang dune 2.0) + > (generate_opam_files true) + > (package (name foo)) + > EOF + + $ cd attached-to-all && dune build + + $ cat attached-to-all/foo.opam + cat: attached-to-all/foo.opam: No such file or directory + [1] From 529424c3fbaa43bd36439e38c130a2aa770a7677 Mon Sep 17 00:00:00 2001 From: Jeremie Dimino Date: Tue, 3 Dec 2019 08:40:32 +0000 Subject: [PATCH 2/2] Fix #2927 Signed-off-by: Jeremie Dimino --- CHANGES.md | 3 + src/dune/gen_rules.ml | 60 ++++++++++--------- .../test-cases/byte-code-only/run.t | 14 ++--- 3 files changed, 43 insertions(+), 34 deletions(-) diff --git a/CHANGES.md b/CHANGES.md index f4c65821611..f264c43d765 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -32,6 +32,9 @@ - Introduce a `strict_package_deps` mode that verifies that dependencies between packages in the workspace are specified correctly. (@rgrinberg, #3117) +- Make sure the `@all` alias is defined when no `dune` file is present + in a directory (#2946, fix #2927, @diml) + 2.2.0 (06/02/2020) ------------------ diff --git a/src/dune/gen_rules.ml b/src/dune/gen_rules.ml index 45415279178..20f3b25774e 100644 --- a/src/dune/gen_rules.ml +++ b/src/dune/gen_rules.ml @@ -164,6 +164,34 @@ let lib_src_dirs ~dir_contents = (* Stanza *) +let define_all_alias ~dir ~scope ~js_targets = + let dyn_deps = + let pred = + let id = + lazy + (let open Dyn.Encoder in + constr "exclude" + (List.map ~f:(fun p -> Path.Build.to_dyn p) js_targets)) + in + List.iter js_targets ~f:(fun js_target -> + assert (Path.Build.equal (Path.Build.parent_exn js_target) dir)); + let f = + if Dune_project.explicit_js_mode (Scope.project scope) then + fun _ -> + true + else + fun basename -> + not + (List.exists js_targets ~f:(fun js_target -> + String.equal (Path.Build.basename js_target) basename)) + in + Predicate.create ~id ~f + in + File_selector.create ~dir:(Path.build dir) pred + |> Build.paths_matching ~loc:Loc.none + in + Rules.Produce.Alias.add_deps ~dyn_deps (Alias.all ~dir) Path.Set.empty + let gen_rules sctx dir_contents cctxs { Dir_with_dune.src_dir; ctx_dir; data = stanzas; scope; dune_version = _ } = @@ -246,39 +274,17 @@ let gen_rules sctx dir_contents cctxs Coq_rules.coqpp_rules ~sctx ~build_dir ~dir:ctx_dir m |> Super_context.add_rules ~dir:ctx_dir sctx | _ -> ()); - let dyn_deps = - let pred = - let id = - lazy - (let open Dyn.Encoder in - constr "exclude" - (List.map ~f:(fun p -> Path.Build.to_dyn p) js_targets)) - in - List.iter js_targets ~f:(fun js_target -> - assert (Path.Build.equal (Path.Build.parent_exn js_target) ctx_dir)); - let f = - if Dune_project.explicit_js_mode (Scope.project scope) then - fun _ -> - true - else - fun basename -> - not - (List.exists js_targets ~f:(fun js_target -> - String.equal (Path.Build.basename js_target) basename)) - in - Predicate.create ~id ~f - in - File_selector.create ~dir:(Path.build ctx_dir) pred - |> Build.paths_matching ~loc:Loc.none - in - Rules.Produce.Alias.add_deps ~dyn_deps (Alias.all ~dir:ctx_dir) Path.Set.empty; + define_all_alias ~dir:ctx_dir ~scope ~js_targets; cctxs let gen_rules sctx dir_contents cctxs ~dir : (Loc.t * Compilation_context.t) list = with_format sctx ~dir ~f:(fun _ -> Format_rules.gen_rules ~dir); match Super_context.stanzas_in sctx ~dir with - | None -> [] + | None -> + define_all_alias ~dir ~js_targets:[] + ~scope:(Super_context.find_scope_by_dir sctx dir); + [] | Some d -> gen_rules sctx dir_contents cctxs d let gen_rules ~sctx ~dir components : Build_system.extra_sub_directories_to_keep diff --git a/test/blackbox-tests/test-cases/byte-code-only/run.t b/test/blackbox-tests/test-cases/byte-code-only/run.t index 0c1cb8082a3..65ad8770c41 100644 --- a/test/blackbox-tests/test-cases/byte-code-only/run.t +++ b/test/blackbox-tests/test-cases/byte-code-only/run.t @@ -1,4 +1,10 @@ $ env ORIG_PATH="$PATH" PATH="$PWD/ocaml-bin:$PATH" dune build @all --display short + ocamldep bin/.toto.eobjs/toto.ml.d + ocamlc bin/.toto.eobjs/byte/dune__exe__Toto.{cmi,cmo,cmt} + ocamlc bin/toto.bc + ocamldep src/.foo.objs/foo.ml.d + ocamlc src/.foo.objs/byte/foo.{cmi,cmo,cmt} + ocamlc src/foo.cma ocamlc build-info/.build_info.objs/byte/build_info.{cmi,cmo,cmt} ocamlc build-info/build_info.cma ocamldep build-info/.build_info.objs/build_info_data.mli.d @@ -7,14 +13,8 @@ ocamldep bin-with-build-info/.print_version.eobjs/print_version.ml.d ocamlc bin-with-build-info/.print_version.eobjs/byte/dune__exe__Print_version.{cmi,cmo,cmt} ocamlc bin-with-build-info/print_version.exe - ocamldep bin/.toto.eobjs/toto.ml.d - ocamlc bin/.toto.eobjs/byte/dune__exe__Toto.{cmi,cmo,cmt} - ocamlc bin/toto.bc - ocamldep src/.foo.objs/foo.ml.d - ocamlc src/.foo.objs/byte/foo.{cmi,cmo,cmt} - ocamlc src/foo.cma - ocamlc bin-with-build-info/print_version.bc ocamlc bin/toto.exe + ocamlc bin-with-build-info/print_version.bc $ _build/default/bin-with-build-info/print_version.exe