From 60c83881b5f5e394fc7607b532c7e0493138d119 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Nicol=C3=A1s=20Ojeda=20B=C3=A4r?= Date: Sat, 17 Aug 2024 07:38:42 +0200 Subject: [PATCH 1/6] Generate `exports` field in META file for `(re_export)` libraries MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Signed-off-by: Nicolás Ojeda Bär --- src/dune_rules/gen_meta.ml | 3 +++ src/dune_rules/lib.ml | 1 + src/dune_rules/lib.mli | 1 + test/blackbox-tests/test-cases/meta-gen.t/dune | 9 +++++++-- test/blackbox-tests/test-cases/meta-gen.t/dune-project | 2 +- test/blackbox-tests/test-cases/meta-gen.t/run.t | 10 ++++++++++ 6 files changed, 23 insertions(+), 3 deletions(-) diff --git a/src/dune_rules/gen_meta.ml b/src/dune_rules/gen_meta.ml index ad6bf39056c..06cad7c865a 100644 --- a/src/dune_rules/gen_meta.ml +++ b/src/dune_rules/gen_meta.ml @@ -36,6 +36,7 @@ end let string_of_deps deps = Lib_name.Set.to_string_list deps |> String.concat ~sep:" " let rule var predicates action value = Rule { var; predicates; action; value } let requires ?(preds = []) pkgs = rule "requires" preds Set (string_of_deps pkgs) +let exports pkgs = rule "exports" [] Set (string_of_deps pkgs) let ppx_runtime_deps ?(preds = []) pkgs = rule "ppx_runtime_deps" preds Set (string_of_deps pkgs) @@ -87,6 +88,7 @@ let gen_lib pub_name lib ~version = in let to_names = Lib_name.Set.of_list_map ~f:name in let* lib_deps = Resolve.Memo.read_memo (Lib.requires lib) >>| to_names in + let* lib_re_exports = Resolve.Memo.read_memo (Lib.re_exports lib) >>| to_names in let* ppx_rt_deps = Lib.ppx_runtime_deps lib |> Memo.bind ~f:Resolve.read_memo |> Memo.map ~f:to_names in @@ -109,6 +111,7 @@ let gen_lib pub_name lib ~version = List.concat [ version ; [ description desc; requires ~preds lib_deps ] + ; (if Lib_name.Set.is_empty lib_re_exports then [] else [ exports lib_re_exports ]) ; archives ~preds lib ; (if Lib_name.Set.is_empty ppx_rt_deps then [] diff --git a/src/dune_rules/lib.ml b/src/dune_rules/lib.ml index f129465994f..1de6a0097c3 100644 --- a/src/dune_rules/lib.ml +++ b/src/dune_rules/lib.ml @@ -433,6 +433,7 @@ let info t = t.info let project t = t.project let implements t = Option.map ~f:Memo.return t.implements let requires t = Memo.return t.requires +let re_exports t = Memo.return t.re_exports let ppx_runtime_deps t = Memo.return t.ppx_runtime_deps let pps t = Memo.return t.pps diff --git a/src/dune_rules/lib.mli b/src/dune_rules/lib.mli index 4952c57067e..e53a74a47e6 100644 --- a/src/dune_rules/lib.mli +++ b/src/dune_rules/lib.mli @@ -24,6 +24,7 @@ val wrapped : t -> Wrapped.t option Resolve.Memo.t (** Direct library dependencies of this library *) val requires : t -> t list Resolve.Memo.t +val re_exports : t -> t list Resolve.Memo.t val ppx_runtime_deps : t -> t list Resolve.Memo.t val pps : t -> t list Resolve.Memo.t diff --git a/test/blackbox-tests/test-cases/meta-gen.t/dune b/test/blackbox-tests/test-cases/meta-gen.t/dune index 91925536c33..ef8b961f5f4 100644 --- a/test/blackbox-tests/test-cases/meta-gen.t/dune +++ b/test/blackbox-tests/test-cases/meta-gen.t/dune @@ -41,6 +41,11 @@ (libraries foobar) (preprocess (pps foobar_rewriter))) -(alias - (name runtest) +(rule + (alias runtest) (action (echo "%{read:META.foobar}"))) + +(library + (name foobar2) + (public_name foobar.foobar2) + (libraries (re_export foobar) (re_export foobar_ppd) foobar_rewriter2)) diff --git a/test/blackbox-tests/test-cases/meta-gen.t/dune-project b/test/blackbox-tests/test-cases/meta-gen.t/dune-project index 6aae99ad17a..929c696e561 100644 --- a/test/blackbox-tests/test-cases/meta-gen.t/dune-project +++ b/test/blackbox-tests/test-cases/meta-gen.t/dune-project @@ -1 +1 @@ -(lang dune 1.9) +(lang dune 2.0) diff --git a/test/blackbox-tests/test-cases/meta-gen.t/run.t b/test/blackbox-tests/test-cases/meta-gen.t/run.t index 8a939042406..1874aa44c67 100644 --- a/test/blackbox-tests/test-cases/meta-gen.t/run.t +++ b/test/blackbox-tests/test-cases/meta-gen.t/run.t @@ -14,6 +14,16 @@ plugin(byte) = "foobar_baz.cma" plugin(native) = "" ) + package "foobar2" ( + directory = "foobar2" + description = "" + requires = "foobar foobar.ppd foobar.rewriter2" + exports = "foobar foobar.ppd" + archive(byte) = "foobar2.cma" + archive(native) = "foobar2.cmxa" + plugin(byte) = "foobar2.cma" + plugin(native) = "foobar2.cmxs" + ) package "ppd" ( directory = "ppd" description = "pp'd with a rewriter" From 1bdd62a4389138050bfc33bf600bbd3455552b96 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Nicol=C3=A1s=20Ojeda=20B=C3=A4r?= Date: Sat, 17 Aug 2024 07:53:45 +0200 Subject: [PATCH 2/6] Interpret `exports` field in META files MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Signed-off-by: Nicolás Ojeda Bär --- src/dune_findlib/package0.ml | 5 +++++ src/dune_findlib/package0.mli | 1 + src/dune_rules/findlib.ml | 7 ++++++- test/expect-tests/findlib_tests.ml | 2 +- test/unit-tests/findlib-db/foo/META | 3 ++- 5 files changed, 15 insertions(+), 3 deletions(-) diff --git a/src/dune_findlib/package0.ml b/src/dune_findlib/package0.ml index 99694f61cd0..8d42b30791c 100644 --- a/src/dune_findlib/package0.ml +++ b/src/dune_findlib/package0.ml @@ -31,6 +31,11 @@ let requires t = |> List.map ~f:(fun s -> Lib_name.parse_string_exn (Loc.none, s)) ;; +let exports t = + Vars.get_words t.vars "exports" Ps.empty + |> List.map ~f:(fun s -> Lib_name.parse_string_exn (Loc.none, s)) +;; + let ppx_runtime_deps t = Vars.get_words t.vars "ppx_runtime_deps" preds |> List.map ~f:(fun s -> Lib_name.parse_string_exn (Loc.none, s)) diff --git a/src/dune_findlib/package0.mli b/src/dune_findlib/package0.mli index c134026e48d..83e8ff5b809 100644 --- a/src/dune_findlib/package0.mli +++ b/src/dune_findlib/package0.mli @@ -12,6 +12,7 @@ val version : t -> string option val description : t -> string option val jsoo_runtime : t -> Path.t list val requires : t -> Lib_name.t list +val exports : t -> Lib_name.t list val ppx_runtime_deps : t -> Lib_name.t list val kind : t -> Lib_kind.t val archives : t -> Path.t list Mode.Dict.t diff --git a/src/dune_rules/findlib.ml b/src/dune_rules/findlib.ml index 05b09cc3788..7a85a2f766f 100644 --- a/src/dune_rules/findlib.ml +++ b/src/dune_rules/findlib.ml @@ -121,8 +121,13 @@ let to_dune_library (t : Findlib.Package.t) ~dir_contents ~ext_lib ~external_loc let main_module_name : Lib_info.Main_module_name.t = This None in let enabled = Memo.return Lib_info.Enabled_status.Normal in let requires = + let exports = Lib_name.Set.of_list (Findlib.Package.exports t) in Findlib.Package.requires t - |> List.map ~f:(fun name -> Lib_dep.direct (add_loc name)) + |> List.map ~f:(fun name -> + let lib_dep = + if Lib_name.Set.mem exports name then Lib_dep.re_export else Lib_dep.direct + in + lib_dep (add_loc name)) in let ppx_runtime_deps = List.map ~f:add_loc (Findlib.Package.ppx_runtime_deps t) in let special_builtin_support : (Loc.t * Lib_info.Special_builtin_support.t) option = diff --git a/test/expect-tests/findlib_tests.ml b/test/expect-tests/findlib_tests.ml index c0d7494726d..becc9be0e5f 100644 --- a/test/expect-tests/findlib_tests.ml +++ b/test/expect-tests/findlib_tests.ml @@ -134,7 +134,7 @@ let%expect_test _ = let dyn = Dyn.list Lib_dep.to_dyn requires in let pp = Dyn.pp dyn in Format.printf "%a@." Pp.to_fmt pp; - [%expect {|[ "baz" ]|}] + [%expect {|[ re_export "baz"; "xyz" ]|}] ;; (* Meta parsing/simplification *) diff --git a/test/unit-tests/findlib-db/foo/META b/test/unit-tests/findlib-db/foo/META index e141935ca82..eeb241cbc1c 100644 --- a/test/unit-tests/findlib-db/foo/META +++ b/test/unit-tests/findlib-db/foo/META @@ -1,2 +1,3 @@ requires = "bar" -requires(ppx_driver) = "baz" +requires(ppx_driver) = "baz xyz" +exports = "baz wrong" From c90f9f095f2b000cd8792876ec5c1cc29375086c Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Nicol=C3=A1s=20Ojeda=20B=C3=A4r?= Date: Sat, 17 Aug 2024 08:17:27 +0200 Subject: [PATCH 3/6] Use `exports` field in META generated by `(deprecated_library_name)` MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Signed-off-by: Nicolás Ojeda Bär --- src/dune_rules/gen_meta.ml | 3 ++- .../test-cases/deprecated-library-name/features.t | 8 ++++++++ 2 files changed, 10 insertions(+), 1 deletion(-) diff --git a/src/dune_rules/gen_meta.ml b/src/dune_rules/gen_meta.ml index 06cad7c865a..0b4d54d6b94 100644 --- a/src/dune_rules/gen_meta.ml +++ b/src/dune_rules/gen_meta.ml @@ -198,9 +198,10 @@ let gen ~(package : Package.t) ~add_directory_entry entries = pub_name, entries) | Deprecated_library_name { old_name = old_public_name, _; new_public_name = _, new_public_name; _ } -> + let deps = Lib_name.Set.singleton new_public_name in Memo.return ( Pub_name.of_lib_name (Public_lib.name old_public_name) - , version @ [ requires (Lib_name.Set.singleton new_public_name) ] )) + , version @ [ requires deps; exports deps ] )) in let pkgs = List.map pkgs ~f:(fun (pn, meta) -> diff --git a/test/blackbox-tests/test-cases/deprecated-library-name/features.t b/test/blackbox-tests/test-cases/deprecated-library-name/features.t index 5ce45c8c044..3416bd29daa 100644 --- a/test/blackbox-tests/test-cases/deprecated-library-name/features.t +++ b/test/blackbox-tests/test-cases/deprecated-library-name/features.t @@ -53,6 +53,7 @@ tests that the "old_public_name" field is evaluated lazily $ dune_cmd cat $PWD/_install/lib/a/META requires = "b" + exports = "b" $ dune_cmd cat $PWD/_install/lib/a/dune-package | sed "s/(lang dune .*)/(lang dune )/" (lang dune ) @@ -144,8 +145,10 @@ First the motivating case. $ dune_cmd cat d/_build/install/default/lib/menhirLib/META requires = "menhir.lib" + exports = "menhir.lib" $ dune_cmd cat d/_build/install/default/lib/menhirSdk/META requires = "menhir.sdk" + exports = "menhir.sdk" $ find d/_build/install/default -name 'dune-package' | sort d/_build/install/default/lib/dummy/dune-package @@ -208,6 +211,7 @@ Checks that we can migrate top-level libraries across packages. $ dune_cmd cat d/_build/install/default/lib/top1/META requires = "q.bar" + exports = "q.bar" Check that we can do it when the name of the new library is the same as the old public name: @@ -227,6 +231,7 @@ old public name: $ dune_cmd cat d/_build/install/default/lib/top2/META requires = "q.top2" + exports = "q.top2" We check that there is an error when there is an actual ambiguity: @@ -304,6 +309,7 @@ Qualified, deprecated old_public_name: $ dune_cmd cat d/_build/install/default/lib/q/META package "foo" ( requires = "p" + exports = "p" ) $ find d/_build/install/default -name 'dune-package' | sort @@ -345,9 +351,11 @@ Two libraries redirecting to the same library: $ dune_cmd cat d/_build/install/default/lib/q/META package "bar" ( requires = "p" + exports = "p" ) package "foo" ( requires = "p" + exports = "p" ) $ find d/_build/install/default -name 'dune-package' | sort From c2cdbb3f376fe6c6b22e2140dffd790309e1aad8 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Nicol=C3=A1s=20Ojeda=20B=C3=A4r?= Date: Sat, 17 Aug 2024 10:16:58 +0200 Subject: [PATCH 4/6] Guard META generation of `exports` with version >= (3, 17) MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Signed-off-by: Nicolás Ojeda Bär --- src/dune_rules/gen_meta.ml | 7 +- .../test-cases/meta-gen.t/dune-project | 1 - .../test-cases/meta-gen.t/run.t | 85 +++++++++++++++++++ 3 files changed, 91 insertions(+), 2 deletions(-) delete mode 100644 test/blackbox-tests/test-cases/meta-gen.t/dune-project diff --git a/src/dune_rules/gen_meta.ml b/src/dune_rules/gen_meta.ml index 0b4d54d6b94..aa34cab6c62 100644 --- a/src/dune_rules/gen_meta.ml +++ b/src/dune_rules/gen_meta.ml @@ -111,7 +111,12 @@ let gen_lib pub_name lib ~version = List.concat [ version ; [ description desc; requires ~preds lib_deps ] - ; (if Lib_name.Set.is_empty lib_re_exports then [] else [ exports lib_re_exports ]) + ; (if (match Lib.project lib with + | None -> true + | Some project -> Dune_project.dune_version project < (3, 17)) + || Lib_name.Set.is_empty lib_re_exports + then [] + else [ exports lib_re_exports ]) ; archives ~preds lib ; (if Lib_name.Set.is_empty ppx_rt_deps then [] diff --git a/test/blackbox-tests/test-cases/meta-gen.t/dune-project b/test/blackbox-tests/test-cases/meta-gen.t/dune-project deleted file mode 100644 index 929c696e561..00000000000 --- a/test/blackbox-tests/test-cases/meta-gen.t/dune-project +++ /dev/null @@ -1 +0,0 @@ -(lang dune 2.0) diff --git a/test/blackbox-tests/test-cases/meta-gen.t/run.t b/test/blackbox-tests/test-cases/meta-gen.t/run.t index 1874aa44c67..e5b9c9067f5 100644 --- a/test/blackbox-tests/test-cases/meta-gen.t/run.t +++ b/test/blackbox-tests/test-cases/meta-gen.t/run.t @@ -1,3 +1,88 @@ + $ echo '(lang dune 2.0)' > dune-project + $ dune runtest --force + description = "contains \"quotes\"" + requires = "bytes" + archive(byte) = "foobar.cma" + archive(native) = "foobar.cmxa" + plugin(byte) = "foobar.cma" + plugin(native) = "foobar.cmxs" + package "baz" ( + directory = "baz" + description = "sub library with modes set to byte" + requires = "bytes" + archive(byte) = "foobar_baz.cma" + archive(native) = "" + plugin(byte) = "foobar_baz.cma" + plugin(native) = "" + ) + package "foobar2" ( + directory = "foobar2" + description = "" + requires = "foobar foobar.ppd foobar.rewriter2" + archive(byte) = "foobar2.cma" + archive(native) = "foobar2.cmxa" + plugin(byte) = "foobar2.cma" + plugin(native) = "foobar2.cmxs" + ) + package "ppd" ( + directory = "ppd" + description = "pp'd with a rewriter" + requires = "foobar foobar.baz foobar.runtime-lib2" + archive(byte) = "foobar_ppd.cma" + archive(native) = "foobar_ppd.cmxa" + plugin(byte) = "foobar_ppd.cma" + plugin(native) = "foobar_ppd.cmxs" + ) + package "rewriter" ( + directory = "rewriter" + description = "ppx rewriter" + requires(ppx_driver) = "foobar foobar.rewriter2" + archive(ppx_driver,byte) = "foobar_rewriter.cma" + archive(ppx_driver,native) = "foobar_rewriter.cmxa" + plugin(ppx_driver,byte) = "foobar_rewriter.cma" + plugin(ppx_driver,native) = "foobar_rewriter.cmxs" + # This is what dune uses to find out the runtime dependencies of + # a preprocessor + ppx_runtime_deps = "foobar.baz" + # This line makes things transparent for people mixing preprocessors + # and normal dependencies + requires(-ppx_driver) = "foobar.baz foobar.runtime-lib2" + ppx(-ppx_driver,-custom_ppx) = "./ppx.exe --as-ppx" + library_kind = "ppx_rewriter" + ) + package "rewriter2" ( + directory = "rewriter2" + description = "ppx rewriter expander" + requires = "foobar" + archive(byte) = "foobar_rewriter2.cma" + archive(native) = "foobar_rewriter2.cmxa" + plugin(byte) = "foobar_rewriter2.cma" + plugin(native) = "foobar_rewriter2.cmxs" + # This is what dune uses to find out the runtime dependencies of + # a preprocessor + ppx_runtime_deps = "foobar.runtime-lib2" + ) + package "runtime-lib2" ( + directory = "runtime-lib2" + description = "runtime library for foobar.rewriter2" + requires = "" + archive(byte) = "foobar_runtime_lib2.cma" + archive(native) = "foobar_runtime_lib2.cmxa" + plugin(byte) = "foobar_runtime_lib2.cma" + plugin(native) = "foobar_runtime_lib2.cmxs" + jsoo_runtime = "foobar_runtime.js foobar_runtime2.js" + ) + package "sub" ( + directory = "sub" + description = "sub library in a sub dir" + requires = "bytes" + archive(byte) = "foobar_sub.cma" + archive(native) = "" + plugin(byte) = "foobar_sub.cma" + plugin(native) = "" + ) + + $ echo '(lang dune 3.17)' > dune-project $ dune runtest --force description = "contains \"quotes\"" requires = "bytes" From 7dc7c8c49d746306b380e3f5b083a276665e01c7 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Nicol=C3=A1s=20Ojeda=20B=C3=A4r?= Date: Sun, 18 Aug 2024 07:07:24 +0200 Subject: [PATCH 5/6] Add compilation test for the new META field MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Signed-off-by: Nicolás Ojeda Bär --- test/blackbox-tests/test-cases/meta-exports.t | 118 ++++++++++++++++++ .../blackbox-tests/test-cases/meta-gen.t/dune | 9 +- .../test-cases/meta-gen.t/dune-project | 1 + .../test-cases/meta-gen.t/run.t | 95 -------------- 4 files changed, 121 insertions(+), 102 deletions(-) create mode 100644 test/blackbox-tests/test-cases/meta-exports.t create mode 100644 test/blackbox-tests/test-cases/meta-gen.t/dune-project diff --git a/test/blackbox-tests/test-cases/meta-exports.t b/test/blackbox-tests/test-cases/meta-exports.t new file mode 100644 index 00000000000..4af8b310943 --- /dev/null +++ b/test/blackbox-tests/test-cases/meta-exports.t @@ -0,0 +1,118 @@ +Check our handling of `exports` in META files. We begin with a test showing that +we can *consume* META files containing an `exports` field. + +To do this, first we create a Findlib hierarchy containing two installed +packages, `foo` and `bar`. The package `foo` is empty and only exists to +re-export `bar`. The package `bar` consists of a bytecode library, `bar.cma`. + + $ mkdir -p _install/foo + $ cat >_install/foo/META < requires = "bar" + > EOF + + $ mkdir -p _install/bar + $ cat >_install/bar/META < archive(byte) = "bar.cma" + > EOF + $ cat >_install/bar/bar.ml < let x = 42 + > EOF + $ ocamlc -a -o _install/bar/bar.cma _install/bar/bar.ml + +We now define a Dune project that will consume `foo`. + + $ cat >dune-project < (lang dune 3.0) + > EOF + + $ cat >dune < (executable + > (name main) + > (modes byte) + > (libraries foo)) + > EOF + $ cat >main.ml < let () = print_int Bar.x; print_newline () + > EOF + +Compilation works with `(implicit_transitive_deps)`: + + $ OCAMLPATH=$(pwd)/_install dune exec ./main.exe + 42 + +However, the compilation without `(implicit_transitive_deps)` fails: + + $ cat >dune-project < (lang dune 3.0) + > (implicit_transitive_deps false) + > EOF + + $ OCAMLPATH=$(pwd)/_install dune exec ./main.exe + File "main.ml", line 1, characters 19-24: + 1 | let () = print_int Bar.x; print_newline () + ^^^^^ + Error: Unbound module Bar + [1] + +Next, we add the `exports` field to `foo`'s `META` file: + + $ cat >_install/foo/META < requires = "bar" + > exports = "bar" + > EOF + +and compilation now works again: + + $ OCAMLPATH=$(pwd)/_install dune exec ./main.exe + 42 + +---------------------------------------------------------------- + +Next, we check that we can *produce* META files with the `export` field. To do +this, we define two Dune libraries `foo` and `bar`, where `foo` depends on `bar` +using `(re_export)`. + + $ cat >dune-project.gen <<'EOF' + > cat < (lang dune $VERSION) + > (package (name foo)) + > (package (name bar)) + > EOF2 + > EOF + + $ cat >dune < (library + > (public_name bar) + > (modules bar)) + > (library + > (public_name foo) + > (libraries (re_export bar)) + > (modules foo)) + > EOF + $ true >bar.ml + $ true >foo.ml + +First we try with dune version 3.16 (it should not generate the `exports` field): + + $ VERSION=3.16 sh dune-project.gen >dune-project + $ dune build && dune install --libdir $(pwd)/_local + $ cat _local/foo/META + description = "" + requires = "bar" + archive(byte) = "foo.cma" + archive(native) = "foo.cmxa" + plugin(byte) = "foo.cma" + plugin(native) = "foo.cmxs" + +Now with dune version 3.17 (it should generate the `exports` field): + + $ VERSION=3.17 sh dune-project.gen >dune-project + $ dune build && dune install --libdir $(pwd)/_local + $ cat _local/foo/META + description = "" + requires = "bar" + exports = "bar" + archive(byte) = "foo.cma" + archive(native) = "foo.cmxa" + plugin(byte) = "foo.cma" + plugin(native) = "foo.cmxs" diff --git a/test/blackbox-tests/test-cases/meta-gen.t/dune b/test/blackbox-tests/test-cases/meta-gen.t/dune index ef8b961f5f4..91925536c33 100644 --- a/test/blackbox-tests/test-cases/meta-gen.t/dune +++ b/test/blackbox-tests/test-cases/meta-gen.t/dune @@ -41,11 +41,6 @@ (libraries foobar) (preprocess (pps foobar_rewriter))) -(rule - (alias runtest) +(alias + (name runtest) (action (echo "%{read:META.foobar}"))) - -(library - (name foobar2) - (public_name foobar.foobar2) - (libraries (re_export foobar) (re_export foobar_ppd) foobar_rewriter2)) diff --git a/test/blackbox-tests/test-cases/meta-gen.t/dune-project b/test/blackbox-tests/test-cases/meta-gen.t/dune-project new file mode 100644 index 00000000000..6aae99ad17a --- /dev/null +++ b/test/blackbox-tests/test-cases/meta-gen.t/dune-project @@ -0,0 +1 @@ +(lang dune 1.9) diff --git a/test/blackbox-tests/test-cases/meta-gen.t/run.t b/test/blackbox-tests/test-cases/meta-gen.t/run.t index e5b9c9067f5..8a939042406 100644 --- a/test/blackbox-tests/test-cases/meta-gen.t/run.t +++ b/test/blackbox-tests/test-cases/meta-gen.t/run.t @@ -1,4 +1,3 @@ - $ echo '(lang dune 2.0)' > dune-project $ dune runtest --force description = "contains \"quotes\"" requires = "bytes" @@ -15,100 +14,6 @@ plugin(byte) = "foobar_baz.cma" plugin(native) = "" ) - package "foobar2" ( - directory = "foobar2" - description = "" - requires = "foobar foobar.ppd foobar.rewriter2" - archive(byte) = "foobar2.cma" - archive(native) = "foobar2.cmxa" - plugin(byte) = "foobar2.cma" - plugin(native) = "foobar2.cmxs" - ) - package "ppd" ( - directory = "ppd" - description = "pp'd with a rewriter" - requires = "foobar foobar.baz foobar.runtime-lib2" - archive(byte) = "foobar_ppd.cma" - archive(native) = "foobar_ppd.cmxa" - plugin(byte) = "foobar_ppd.cma" - plugin(native) = "foobar_ppd.cmxs" - ) - package "rewriter" ( - directory = "rewriter" - description = "ppx rewriter" - requires(ppx_driver) = "foobar foobar.rewriter2" - archive(ppx_driver,byte) = "foobar_rewriter.cma" - archive(ppx_driver,native) = "foobar_rewriter.cmxa" - plugin(ppx_driver,byte) = "foobar_rewriter.cma" - plugin(ppx_driver,native) = "foobar_rewriter.cmxs" - # This is what dune uses to find out the runtime dependencies of - # a preprocessor - ppx_runtime_deps = "foobar.baz" - # This line makes things transparent for people mixing preprocessors - # and normal dependencies - requires(-ppx_driver) = "foobar.baz foobar.runtime-lib2" - ppx(-ppx_driver,-custom_ppx) = "./ppx.exe --as-ppx" - library_kind = "ppx_rewriter" - ) - package "rewriter2" ( - directory = "rewriter2" - description = "ppx rewriter expander" - requires = "foobar" - archive(byte) = "foobar_rewriter2.cma" - archive(native) = "foobar_rewriter2.cmxa" - plugin(byte) = "foobar_rewriter2.cma" - plugin(native) = "foobar_rewriter2.cmxs" - # This is what dune uses to find out the runtime dependencies of - # a preprocessor - ppx_runtime_deps = "foobar.runtime-lib2" - ) - package "runtime-lib2" ( - directory = "runtime-lib2" - description = "runtime library for foobar.rewriter2" - requires = "" - archive(byte) = "foobar_runtime_lib2.cma" - archive(native) = "foobar_runtime_lib2.cmxa" - plugin(byte) = "foobar_runtime_lib2.cma" - plugin(native) = "foobar_runtime_lib2.cmxs" - jsoo_runtime = "foobar_runtime.js foobar_runtime2.js" - ) - package "sub" ( - directory = "sub" - description = "sub library in a sub dir" - requires = "bytes" - archive(byte) = "foobar_sub.cma" - archive(native) = "" - plugin(byte) = "foobar_sub.cma" - plugin(native) = "" - ) - - $ echo '(lang dune 3.17)' > dune-project - $ dune runtest --force - description = "contains \"quotes\"" - requires = "bytes" - archive(byte) = "foobar.cma" - archive(native) = "foobar.cmxa" - plugin(byte) = "foobar.cma" - plugin(native) = "foobar.cmxs" - package "baz" ( - directory = "baz" - description = "sub library with modes set to byte" - requires = "bytes" - archive(byte) = "foobar_baz.cma" - archive(native) = "" - plugin(byte) = "foobar_baz.cma" - plugin(native) = "" - ) - package "foobar2" ( - directory = "foobar2" - description = "" - requires = "foobar foobar.ppd foobar.rewriter2" - exports = "foobar foobar.ppd" - archive(byte) = "foobar2.cma" - archive(native) = "foobar2.cmxa" - plugin(byte) = "foobar2.cma" - plugin(native) = "foobar2.cmxs" - ) package "ppd" ( directory = "ppd" description = "pp'd with a rewriter" From 09102f7eb44f180176474da0e654b51ca6b07656 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Nicol=C3=A1s=20Ojeda=20B=C3=A4r?= Date: Mon, 19 Aug 2024 07:00:02 +0200 Subject: [PATCH 6/6] Changes MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Signed-off-by: Nicolás Ojeda Bär --- doc/changes/10831.md | 6 ++++++ 1 file changed, 6 insertions(+) create mode 100644 doc/changes/10831.md diff --git a/doc/changes/10831.md b/doc/changes/10831.md new file mode 100644 index 00000000000..3b8f69e2911 --- /dev/null +++ b/doc/changes/10831.md @@ -0,0 +1,6 @@ +- Map `(re_export)` library dependencies to the `exports` field in `META` files, + and vice-versa. This field was proposed in to + https://discuss.ocaml.org/t/proposal-a-new-exports-field-in-findlib-meta-files/13947. + The field is included in Dune-generated `META` files only when the Dune lang + version is >= 3.17. + (#10831, @nojb)