diff --git a/doc/jbuild.rst b/doc/jbuild.rst index 1da079f71959..7506d4972eb6 100644 --- a/doc/jbuild.rst +++ b/doc/jbuild.rst @@ -248,6 +248,10 @@ Executables can also be linked as object or shared object files. See - ``(link_flags )`` specifies additional flags to pass to the linker. This field supports ``(:include ...)`` forms +- ``(link_deps ())`` specifies the dependencies used only by the + linker, for example when using a version script. See the `Dependency + specification`_ section for more details. + - ``(modules )`` specifies which modules in the current directory Jbuilder should consider when building this executable. Modules not listed here will be ignored and cannot be used inside the executable described by diff --git a/src/exe.ml b/src/exe.ml index ebf90424820a..1c4932d4f3f3 100644 --- a/src/exe.ml +++ b/src/exe.ml @@ -108,6 +108,7 @@ let link_exe ~(linkage:Linkage.t) ~top_sorted_modules ?(link_flags=Build.arr (fun _ -> [])) + ?(link_deps=Build.arr (fun _ -> [])) ?(js_of_ocaml=Jbuild.Js_of_ocaml.default) cctx = @@ -137,7 +138,9 @@ let link_exe artifacts modules ~ext:ctx.ext_obj)) in SC.add_rule sctx - (Build.fanout3 + (link_deps >>^ ignore + >>> + Build.fanout3 (register_native_objs_deps modules_and_cm_files >>^ snd) (Ocaml_flags.get (CC.flags cctx) mode) link_flags @@ -173,6 +176,7 @@ let build_and_link_many ~linkages ?already_used ?link_flags + ?link_deps ?(js_of_ocaml=Jbuild.Js_of_ocaml.default) cctx = @@ -194,7 +198,8 @@ let build_and_link_many ~linkage ~top_sorted_modules ~js_of_ocaml - ?link_flags)) + ?link_flags + ?link_deps)) let build_and_link ~program = build_and_link_many ~programs:[program] diff --git a/src/exe.mli b/src/exe.mli index 7509d9e00ec3..db1334273c4e 100644 --- a/src/exe.mli +++ b/src/exe.mli @@ -1,3 +1,5 @@ +open! Import + (** Compilation and linking of executables *) module Program : sig @@ -41,6 +43,7 @@ val build_and_link -> linkages:Linkage.t list -> ?already_used:Module.Name.Set.t -> ?link_flags:(unit, string list) Build.t + -> ?link_deps:(unit, Path.t list) Build.t -> ?js_of_ocaml:Jbuild.Js_of_ocaml.t -> Compilation_context.t -> unit @@ -50,6 +53,7 @@ val build_and_link_many -> linkages:Linkage.t list -> ?already_used:Module.Name.Set.t -> ?link_flags:(unit, string list) Build.t + -> ?link_deps:(unit, Path.t list) Build.t -> ?js_of_ocaml:Jbuild.Js_of_ocaml.t -> Compilation_context.t -> unit @@ -62,6 +66,7 @@ val link_exe -> linkage:Linkage.t -> top_sorted_modules:(unit, Module.t list) Build.t -> ?link_flags:(unit, string list) Build.t + -> ?link_deps:(unit, Path.t list) Build.t -> ?js_of_ocaml:Jbuild.Js_of_ocaml.t -> Compilation_context.t -> unit diff --git a/src/gen_rules.ml b/src/gen_rules.ml index 8f7cf26c326b..2e8868ea2baa 100644 --- a/src/gen_rules.ml +++ b/src/gen_rules.ml @@ -885,11 +885,16 @@ module Gen(P : Install_rules.Params) = struct ~loc:exes.buildable.loc ~modules in + let link_deps = + SC.Deps.interpret sctx ~scope ~dir exes.link_deps + in + Exe.build_and_link_many cctx ~programs ~already_used ~linkages ~link_flags + ~link_deps ~js_of_ocaml:exes.buildable.js_of_ocaml; Merlin.make () diff --git a/src/jbuild.ml b/src/jbuild.ml index 3b1a786a1d33..aaf6e0ef9288 100644 --- a/src/jbuild.ml +++ b/src/jbuild.ml @@ -875,6 +875,7 @@ module Executables = struct { names : (Loc.t * string) list ; link_executables : bool ; link_flags : Ordered_set_lang.Unexpanded.t + ; link_deps : Dep_conf.t list ; modes : Link_mode.Set.t ; buildable : Buildable.t } @@ -882,6 +883,7 @@ module Executables = struct let common_v1 project names public_names ~multi = Buildable.v1 >>= fun buildable -> field "link_executables" bool ~default:true >>= fun link_executables -> + field "link_deps" (list Dep_conf.t) ~default:[] >>= fun link_deps -> field_oslu "link_flags" >>= fun link_flags -> field "modes" Link_mode.Set.t ~default:Link_mode.Set.default >>= fun modes -> @@ -898,6 +900,7 @@ module Executables = struct { names ; link_executables ; link_flags + ; link_deps ; modes ; buildable } diff --git a/src/jbuild.mli b/src/jbuild.mli index 138f26040db4..5dfaf9e2e9ed 100644 --- a/src/jbuild.mli +++ b/src/jbuild.mli @@ -259,6 +259,7 @@ module Executables : sig { names : (Loc.t * string) list ; link_executables : bool ; link_flags : Ordered_set_lang.Unexpanded.t + ; link_deps : Dep_conf.t list ; modes : Link_mode.Set.t ; buildable : Buildable.t } diff --git a/test/blackbox-tests/dune.inc b/test/blackbox-tests/dune.inc index d40afb2c9e3e..5641482175e1 100644 --- a/test/blackbox-tests/dune.inc +++ b/test/blackbox-tests/dune.inc @@ -330,6 +330,14 @@ test-cases/lib-available (progn (run ${exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))) +(alias + ((name link-deps) + (deps ((package dune) (files_recursively_in test-cases/link-deps))) + (action + (chdir + test-cases/link-deps + (progn (run ${exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))) + (alias ((name loop) (deps ((package dune) (files_recursively_in test-cases/loop))) @@ -592,6 +600,7 @@ (alias installable-dup-private-libs) (alias intf-only) (alias lib-available) + (alias link-deps) (alias loop) (alias menhir) (alias merlin-tests) @@ -656,6 +665,7 @@ (alias installable-dup-private-libs) (alias intf-only) (alias lib-available) + (alias link-deps) (alias loop) (alias merlin-tests) (alias meta-gen) diff --git a/test/blackbox-tests/test-cases/link-deps/another.ml b/test/blackbox-tests/test-cases/link-deps/another.ml new file mode 100644 index 000000000000..e69de29bb2d1 diff --git a/test/blackbox-tests/test-cases/link-deps/dune b/test/blackbox-tests/test-cases/link-deps/dune new file mode 100644 index 000000000000..ec9ff30e81ce --- /dev/null +++ b/test/blackbox-tests/test-cases/link-deps/dune @@ -0,0 +1,11 @@ +(alias + ((name message) + (deps (link_deps.cmo)) + (action (echo "link\n")) + )) + +(executable + ((name link_deps) + (link_deps ((alias message))) + ) + ) diff --git a/test/blackbox-tests/test-cases/link-deps/dune-project b/test/blackbox-tests/test-cases/link-deps/dune-project new file mode 100644 index 000000000000..de4fc2092005 --- /dev/null +++ b/test/blackbox-tests/test-cases/link-deps/dune-project @@ -0,0 +1 @@ +(lang dune 1.0) diff --git a/test/blackbox-tests/test-cases/link-deps/link_deps.ml b/test/blackbox-tests/test-cases/link-deps/link_deps.ml new file mode 100644 index 000000000000..e69de29bb2d1 diff --git a/test/blackbox-tests/test-cases/link-deps/run.t b/test/blackbox-tests/test-cases/link-deps/run.t new file mode 100644 index 000000000000..9aaf62ae4cb0 --- /dev/null +++ b/test/blackbox-tests/test-cases/link-deps/run.t @@ -0,0 +1,12 @@ +It is possible to add link-time dependencies. + +In particular, these can depend on the result of the compilation (like a .cmo +file) and be created just before linking. + + $ dune build --display short link_deps.exe + ocamldep another.ml.d + ocamldep link_deps.ml.d + ocamlc .link_deps.eobjs/link_deps.{cmi,cmo,cmt} + link + ocamlopt .link_deps.eobjs/link_deps.{cmx,o} + ocamlopt link_deps.exe