From b187d6e4ba5b3a54fb516ddab3e3b5cc46bb3ac8 Mon Sep 17 00:00:00 2001 From: Rudi Grinberg Date: Fri, 16 Mar 2018 01:35:19 +0800 Subject: [PATCH 01/14] Add the (package ..) dependency type Add a (package ) dependency type which adds a dependency on all the installable files of a package. --- src/build_system.ml | 4 ++++ src/build_system.mli | 2 ++ src/install_rules.ml | 2 ++ src/jbuild.ml | 5 +++++ src/jbuild.mli | 1 + src/super_context.ml | 4 ++++ 6 files changed, 18 insertions(+) diff --git a/src/build_system.ml b/src/build_system.ml index 275fed05..071099bb 100644 --- a/src/build_system.ml +++ b/src/build_system.ml @@ -278,6 +278,10 @@ module Alias0 = struct let doc = make "doc" let private_doc = make "doc-private" let lint = make "lint" + + let package_install ~(context : Context.t) ~pkg = + make (sprintf "install-%s" (Package.Name.to_string pkg)) + ~dir:context.build_dir end module Dir_status = struct diff --git a/src/build_system.mli b/src/build_system.mli index df6edbc5..84df0422 100644 --- a/src/build_system.mli +++ b/src/build_system.mli @@ -107,6 +107,8 @@ module Alias : sig val private_doc : dir:Path.t -> t val lint : dir:Path.t -> t + val package_install : context:Context.t -> pkg:Package.Name.t -> t + (** Return the underlying stamp file *) val stamp_file : t -> Path.t diff --git a/src/install_rules.ml b/src/install_rules.ml index 67a5f5b2..8d7eb6e4 100644 --- a/src/install_rules.ml +++ b/src/install_rules.ml @@ -206,6 +206,8 @@ module Gen(P : Install_params) = struct Path.append install_dir (Install.Entry.relative_installed_path entry ~package) in SC.add_rule sctx (Build.symlink ~src:entry.src ~dst); + SC.add_alias_deps sctx + (Alias.package_install ~context:ctx ~pkg:package) [dst]; Install.Entry.set_src entry dst) let promote_install_file = diff --git a/src/jbuild.ml b/src/jbuild.ml index 303acd78..df692fb0 100644 --- a/src/jbuild.ml +++ b/src/jbuild.ml @@ -230,6 +230,7 @@ module Dep_conf = struct | Alias_rec of String_with_vars.t | Glob_files of String_with_vars.t | Files_recursively_in of String_with_vars.t + | Package of String_with_vars.t | Universe let t = @@ -243,6 +244,7 @@ module Dep_conf = struct ; cstr_sw "alias_rec" (fun x -> Alias_rec x) ; cstr_sw "glob_files" (fun x -> Glob_files x) ; cstr_sw "files_recursively_in" (fun x -> Files_recursively_in x) + ; cstr_sw "package" (fun x -> Package x) ; cstr "universe" nil Universe ] in @@ -266,6 +268,9 @@ module Dep_conf = struct | Files_recursively_in t -> List [Sexp.unsafe_atom_of_string "files_recursively_in" ; String_with_vars.sexp_of_t t] + | Package t -> + List [Sexp.unsafe_atom_of_string "package" ; + String_with_vars.sexp_of_t t] | Universe -> Sexp.unsafe_atom_of_string "universe" end diff --git a/src/jbuild.mli b/src/jbuild.mli index 82c5a64c..a5fa3a9c 100644 --- a/src/jbuild.mli +++ b/src/jbuild.mli @@ -125,6 +125,7 @@ module Dep_conf : sig | Alias_rec of String_with_vars.t | Glob_files of String_with_vars.t | Files_recursively_in of String_with_vars.t + | Package of String_with_vars.t | Universe val t : t Sexp.Of_sexp.t diff --git a/src/super_context.ml b/src/super_context.ml index 214c423a..b8733474 100644 --- a/src/super_context.ml +++ b/src/super_context.ml @@ -351,6 +351,10 @@ module Deps = struct let path = Path.relative dir (expand_vars t ~scope ~dir s) in Build.files_recursively_in ~dir:path ~file_tree:t.file_tree >>^ Pset.to_list + | Package p -> + let pkg = Package.Name.of_string (expand_vars t ~scope ~dir p) in + Alias.dep (Alias.package_install ~context:t.context ~pkg) + >>^ fun () -> [] | Universe -> Build.path Build_system.universe_file >>^ fun () -> [] From 727d9688e9659fc4c1ac4242642aebc67fe61efc Mon Sep 17 00:00:00 2001 From: Rudi Grinberg Date: Fri, 16 Mar 2018 01:37:33 +0800 Subject: [PATCH 02/14] Add tests for (package foo) dependency type --- test/blackbox-tests/jbuild | 10 ++++++++++ test/blackbox-tests/test-cases/package-dep/foo.ml | 0 test/blackbox-tests/test-cases/package-dep/foo.opam | 0 test/blackbox-tests/test-cases/package-dep/jbuild | 11 +++++++++++ test/blackbox-tests/test-cases/package-dep/run.t | 8 ++++++++ 5 files changed, 29 insertions(+) create mode 100644 test/blackbox-tests/test-cases/package-dep/foo.ml create mode 100644 test/blackbox-tests/test-cases/package-dep/foo.opam create mode 100644 test/blackbox-tests/test-cases/package-dep/jbuild create mode 100644 test/blackbox-tests/test-cases/package-dep/run.t diff --git a/test/blackbox-tests/jbuild b/test/blackbox-tests/jbuild index 4d3f6294..d08c7d37 100644 --- a/test/blackbox-tests/jbuild +++ b/test/blackbox-tests/jbuild @@ -440,3 +440,13 @@ (progn (run ${exe:cram.exe} run.t) (diff? run.t run.t.corrected))))))) + +(alias + ((name runtest) + (deps ((files_recursively_in test-cases/package-dep))) + (action + (chdir test-cases/package-dep + (setenv JBUILDER ${bin:jbuilder} + (progn + (run ${exe:cram.exe} run.t) + (diff? run.t run.t.corrected))))))) diff --git a/test/blackbox-tests/test-cases/package-dep/foo.ml b/test/blackbox-tests/test-cases/package-dep/foo.ml new file mode 100644 index 00000000..e69de29b diff --git a/test/blackbox-tests/test-cases/package-dep/foo.opam b/test/blackbox-tests/test-cases/package-dep/foo.opam new file mode 100644 index 00000000..e69de29b diff --git a/test/blackbox-tests/test-cases/package-dep/jbuild b/test/blackbox-tests/test-cases/package-dep/jbuild new file mode 100644 index 00000000..b1117511 --- /dev/null +++ b/test/blackbox-tests/test-cases/package-dep/jbuild @@ -0,0 +1,11 @@ +(jbuild_version 1) + +(library + ((name foo) + (public_name foo) + (modules (foo)))) + +(alias + ((name runtest) + (deps ((package foo))) + (action (echo "package foo")))) diff --git a/test/blackbox-tests/test-cases/package-dep/run.t b/test/blackbox-tests/test-cases/package-dep/run.t new file mode 100644 index 00000000..08c9309d --- /dev/null +++ b/test/blackbox-tests/test-cases/package-dep/run.t @@ -0,0 +1,8 @@ + $ $JBUILDER runtest -j1 --display short --root . + ocamldep foo.ml.d + ocamlc .foo.objs/foo.{cmi,cmo,cmt} + ocamlopt .foo.objs/foo.{cmx,o} + ocamlopt foo.{a,cmxa} + ocamlopt foo.cmxs + ocamlc foo.cma + package foo From ee5dd505fb99144d659c7a7d42562494f0e445c4 Mon Sep 17 00:00:00 2001 From: Jeremie Dimino Date: Thu, 15 Mar 2018 17:42:56 +0000 Subject: [PATCH 03/14] comment --- src/build_system.mli | 2 ++ 1 file changed, 2 insertions(+) diff --git a/src/build_system.mli b/src/build_system.mli index 84df0422..5dd60c2d 100644 --- a/src/build_system.mli +++ b/src/build_system.mli @@ -107,6 +107,8 @@ module Alias : sig val private_doc : dir:Path.t -> t val lint : dir:Path.t -> t + (** Alias for all the files in [_build/install] that belong to this + package *) val package_install : context:Context.t -> pkg:Package.Name.t -> t (** Return the underlying stamp file *) From 1a4037f8d135489f3f67425c672121b2420292d1 Mon Sep 17 00:00:00 2001 From: Jeremie Dimino Date: Thu, 15 Mar 2018 17:44:46 +0000 Subject: [PATCH 04/14] Define the package_install alias at once This is slightly more efficient that calling `add_alias_deps` for each file. --- src/install_rules.ml | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/src/install_rules.ml b/src/install_rules.ml index 8d7eb6e4..6db17359 100644 --- a/src/install_rules.ml +++ b/src/install_rules.ml @@ -206,8 +206,6 @@ module Gen(P : Install_params) = struct Path.append install_dir (Install.Entry.relative_installed_path entry ~package) in SC.add_rule sctx (Build.symlink ~src:entry.src ~dst); - SC.add_alias_deps sctx - (Alias.package_install ~context:ctx ~pkg:package) [dst]; Install.Entry.set_src entry dst) let promote_install_file = @@ -239,6 +237,9 @@ module Gen(P : Install_params) = struct (Utils.install_file ~package ~findlib_toolchain:ctx.findlib_toolchain) in let entries = local_install_rules entries ~package in + SC.add_alias_deps sctx + (Alias.package_install ~context:ctx ~pkg:package) + (List.map entries ~f:(fun (e : Install.Entry.t) -> e.src)); SC.add_rule sctx ~mode:(if promote_install_file then Promote_but_delete_on_clean From 1b8fbfc149e0b19ca9f27f76b03b7ea7287fa484 Mon Sep 17 00:00:00 2001 From: Jeremie Dimino Date: Thu, 15 Mar 2018 17:50:03 +0000 Subject: [PATCH 05/14] Use an alias name that is less likely to clash with user aliases --- src/build_system.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/build_system.ml b/src/build_system.ml index 071099bb..ef4bec8a 100644 --- a/src/build_system.ml +++ b/src/build_system.ml @@ -280,7 +280,7 @@ module Alias0 = struct let lint = make "lint" let package_install ~(context : Context.t) ~pkg = - make (sprintf "install-%s" (Package.Name.to_string pkg)) + make (sprintf ".%s-files" (Package.Name.to_string pkg)) ~dir:context.build_dir end From 73873b31bc83678ad3fd8f82f418c3b1166929d1 Mon Sep 17 00:00:00 2001 From: Jeremie Dimino Date: Thu, 15 Mar 2018 19:50:02 +0000 Subject: [PATCH 06/14] Recursive package deps --- src/build.ml | 2 ++ src/build.mli | 4 ++++ src/build_interpret.ml | 8 +++++++- src/build_interpret.mli | 2 ++ src/build_system.ml | 39 ++++++++++++++++++++++++++++++++++++++- src/build_system.mli | 8 ++++++++ src/fiber/fiber.ml | 6 ++++++ src/fiber/fiber.mli | 6 ++++++ src/install_rules.ml | 21 ++++++++++++++++++--- src/super_context.ml | 5 +++-- src/super_context.mli | 2 ++ 11 files changed, 96 insertions(+), 7 deletions(-) diff --git a/src/build.ml b/src/build.ml index 4902aba9..32e1f912 100644 --- a/src/build.ml +++ b/src/build.ml @@ -27,6 +27,7 @@ module Repr = struct | Split : ('a, 'b) t * ('c, 'd) t -> ('a * 'c, 'b * 'd) t | Fanout : ('a, 'b) t * ('a, 'c) t -> ('a, 'b * 'c) t | Paths : Pset.t -> ('a, 'a) t + | Paths_for_rule : Path.Set.t -> ('a, 'a) t | Paths_glob : glob_state ref -> ('a, Path.t list) t (* The reference gets decided in Build_interpret.deps *) | If_file_exists : Path.t * ('a, 'b) if_file_exists_state ref -> ('a, 'b) t @@ -135,6 +136,7 @@ let path_set ps = Paths ps let paths_glob ~loc ~dir re = Paths_glob (ref (G_unevaluated (loc, dir, re))) let vpath vp = Vpath vp let dyn_paths t = Dyn_paths t +let paths_for_rule ps = Paths_for_rule ps let catch t ~on_error = Catch (t, on_error) diff --git a/src/build.mli b/src/build.mli index 1dc7904e..d8c704d7 100644 --- a/src/build.mli +++ b/src/build.mli @@ -183,6 +183,7 @@ module Repr : sig | Split : ('a, 'b) t * ('c, 'd) t -> ('a * 'c, 'b * 'd) t | Fanout : ('a, 'b) t * ('a, 'c) t -> ('a, 'b * 'c) t | Paths : Path.Set.t -> ('a, 'a) t + | Paths_for_rule : Path.Set.t -> ('a, 'a) t | Paths_glob : glob_state ref -> ('a, Path.t list) t | If_file_exists : Path.t * ('a, 'b) if_file_exists_state ref -> ('a, 'b) t | Contents : Path.t -> ('a, string) t @@ -220,3 +221,6 @@ end val repr : ('a, 'b) t -> ('a, 'b) Repr.t val merge_lib_deps : lib_deps -> lib_deps -> lib_deps + +(**/**) +val paths_for_rule : Path.Set.t -> ('a, 'a) t diff --git a/src/build_interpret.ml b/src/build_interpret.ml index 37c55471..f559174d 100644 --- a/src/build_interpret.ml +++ b/src/build_interpret.ml @@ -63,6 +63,8 @@ let static_deps t ~all_targets ~file_tree = | Split (a, b) -> loop a (loop b acc) | Fanout (a, b) -> loop a (loop b acc) | Paths fns -> { acc with action_deps = Pset.union fns acc.action_deps } + | Paths_for_rule fns -> + { acc with rule_deps = Pset.union fns acc.rule_deps } | Paths_glob state -> begin match !state with | G_evaluated l -> @@ -129,6 +131,7 @@ let lib_deps = | Split (a, b) -> loop a (loop b acc) | Fanout (a, b) -> loop a (loop b acc) | Paths _ -> acc + | Paths_for_rule _ -> acc | Vpath _ -> acc | Paths_glob _ -> acc | Dyn_paths t -> loop t acc @@ -156,6 +159,7 @@ let targets = | Split (a, b) -> loop a (loop b acc) | Fanout (a, b) -> loop a (loop b acc) | Paths _ -> acc + | Paths_for_rule _ -> acc | Vpath _ -> acc | Paths_glob _ -> acc | Dyn_paths t -> loop t acc @@ -188,10 +192,11 @@ module Rule = struct ; locks : Path.t list ; loc : Loc.t option ; dir : Path.t + ; package : Package.Name.t option } let make ?(sandbox=false) ?(mode=Jbuild.Rule.Mode.Not_a_rule_stanza) - ~context ?(locks=[]) ?loc build = + ~context ?(locks=[]) ?loc ?package build = let targets = targets build in let dir = match targets with @@ -225,5 +230,6 @@ module Rule = struct ; locks ; loc ; dir + ; package } end diff --git a/src/build_interpret.mli b/src/build_interpret.mli index 5d2f08c7..01bf3687 100644 --- a/src/build_interpret.mli +++ b/src/build_interpret.mli @@ -20,6 +20,7 @@ module Rule : sig ; loc : Loc.t option ; (** Directory where all the targets are produced *) dir : Path.t + ; package : Package.Name.t option } val make @@ -28,6 +29,7 @@ module Rule : sig -> context:Context.t option -> ?locks:Path.t list -> ?loc:Loc.t + -> ?package:Package.Name.t -> (unit, Action.t) Build.t -> t end diff --git a/src/build_system.ml b/src/build_system.ml index ef4bec8a..99fbaad1 100644 --- a/src/build_system.ml +++ b/src/build_system.ml @@ -161,6 +161,7 @@ module Internal_rule = struct ; loc : Loc.t option ; dir : Path.t ; mutable exec : Exec_status.t + ; package : Package.Name.t option } let compare a b = Id.compare a.id b.id @@ -446,6 +447,7 @@ module Build_exec = struct let b = exec dyn_deps b x in (a, b) | Paths _ -> x + | Paths_for_rule _ -> x | Paths_glob state -> get_glob_result_exn state | Contents p -> Io.read_file (Path.to_string p) | Lines_of p -> Io.lines_of_file (Path.to_string p) @@ -650,6 +652,7 @@ let rec compile_rule t ?(copy_source=false) pre_rule = ; locks ; loc ; dir + ; package } = pre_rule in @@ -774,6 +777,7 @@ let rec compile_rule t ?(copy_source=false) pre_rule = ; mode ; loc ; dir + ; package } in create_file_specs t target_specs rule ~copy_source @@ -1328,7 +1332,8 @@ let build_rules_internal ?(recursive=false) t ~request = else begin rules_seen := Id_set.add !rules_seen ir.id; (match ir.exec with - | Running { rule_evaluation; _ } | Evaluating_rule { rule_evaluation; _ } -> + | Running { rule_evaluation; _ } + | Evaluating_rule { rule_evaluation; _ } -> Fiber.return rule_evaluation | Not_started { eval_rule; exec_rule } -> Fiber.fork (fun () -> @@ -1385,6 +1390,38 @@ let build_rules ?recursive t ~request = entry_point t ~f:(fun () -> build_rules_internal ?recursive t ~request) +let package_deps t files = + let rules_seen = ref Id_set.empty in + let packages = ref Package.Name.Set.empty in + let rec loop fn = + let dir = Path.parent fn in + if Path.is_in_build_dir dir then load_dir t ~dir; + match Hashtbl.find t.files fn with + | None -> () + | Some (File_spec.T { rule = ir; _ }) -> + if not (Id_set.mem !rules_seen ir.id) then begin + rules_seen := Id_set.add !rules_seen ir.id; + let _, dyn_deps = + match ir.exec with + | Running { rule_evaluation; _ } + | Evaluating_rule { rule_evaluation; _ } -> + Option.value_exn (Fiber.Future.peek rule_evaluation) + | Not_started _ -> assert false + in + match ir.package with + | None -> + Pset.iter (Pset.union ir.static_deps dyn_deps) ~f:loop + | Some p -> + packages := Package.Name.Set.add !packages p + end + in + let open Build.O in + Build.paths_for_rule files >>^ fun () -> + (* This is a bit ugly, we know that at this point of execution, all + the relevant ivars have been filled *) + Pset.iter files ~f:loop; + !packages + (* +-----------------------------------------------------------------+ | Adding rules to the system | +-----------------------------------------------------------------+ *) diff --git a/src/build_system.mli b/src/build_system.mli index 5dd60c2d..0a3aaea8 100644 --- a/src/build_system.mli +++ b/src/build_system.mli @@ -77,6 +77,14 @@ val on_load_dir : t -> dir:Path.t -> f:(unit -> unit) -> unit (** Stamp file that depends on all files of [dir] with extension [ext]. *) val stamp_file_for_files_of : t -> dir:Path.t -> ext:string -> Path.t +(** Scan the transitive dependencies of the following files and return + set of packages these files are part of. Do not scan packages + recursively. *) +val package_deps + : t + -> Path.Set.t + -> (unit, Package.Name.Set.t) Build.t + (** {2 Aliases} *) module Alias : sig diff --git a/src/fiber/fiber.ml b/src/fiber/fiber.ml index 3903acd0..10fd3252 100644 --- a/src/fiber/fiber.ml +++ b/src/fiber/fiber.ml @@ -386,12 +386,18 @@ module Ivar = struct | Full x -> k x | Empty q -> Queue.push { Handler. run = k; ctx } q + + let peek t = + match t.state with + | Full x -> Some x + | Empty _ -> None end module Future = struct type 'a t = 'a Ivar.t let wait = Ivar.read + let peek = Ivar.peek end let fork f ctx k = diff --git a/src/fiber/fiber.mli b/src/fiber/fiber.mli index 9bbf1b0d..d1c7851d 100644 --- a/src/fiber/fiber.mli +++ b/src/fiber/fiber.mli @@ -40,6 +40,9 @@ module Future : sig (** Wait for the given future to yield a value. *) val wait : 'a t -> 'a fiber + + (** Return [Some x] if [t] has already returned. *) + val peek : 'a t -> 'a option end with type 'a fiber := 'a t (** [fork f] creates a sub-fiber and return a [Future.t] to wait its result. *) @@ -226,6 +229,9 @@ module Ivar : sig (** Fill the ivar with the following value. This can only be called once for a given ivar. *) val fill : 'a t -> 'a -> unit fiber + + (** Return [Some x] is [fill t x] has been called previously. *) + val peek : 'a t -> 'a option end with type 'a fiber := 'a t module Mutex : sig diff --git a/src/install_rules.ml b/src/install_rules.ml index 6db17359..7c948d76 100644 --- a/src/install_rules.ml +++ b/src/install_rules.ml @@ -205,7 +205,7 @@ module Gen(P : Install_params) = struct let dst = Path.append install_dir (Install.Entry.relative_installed_path entry ~package) in - SC.add_rule sctx (Build.symlink ~src:entry.src ~dst); + SC.add_rule sctx (Build.symlink ~src:entry.src ~dst) ~package; Install.Entry.set_src entry dst) let promote_install_file = @@ -237,9 +237,24 @@ module Gen(P : Install_params) = struct (Utils.install_file ~package ~findlib_toolchain:ctx.findlib_toolchain) in let entries = local_install_rules entries ~package in - SC.add_alias_deps sctx + SC.add_alias_action sctx ~stamp:(List []) (Alias.package_install ~context:ctx ~pkg:package) - (List.map entries ~f:(fun (e : Install.Entry.t) -> e.src)); + (let files = + List.map entries ~f:(fun (e : Install.Entry.t) -> e.src) + |> Path.Set.of_list + in + Build.path_set files + >>> + Build_system.package_deps (SC.build_system sctx) files + >>> + Build.dyn_paths (Build.arr (fun packages -> + Package.Name.Set.remove packages package + |> Package.Name.Set.to_list + |> List.map ~f:(fun pkg -> + Build_system.Alias.package_install + ~context:(SC.context sctx) ~pkg + |> Build_system.Alias.stamp_file))) + >>^ fun _ -> Action.Progn []); SC.add_rule sctx ~mode:(if promote_install_file then Promote_but_delete_on_clean diff --git a/src/super_context.ml b/src/super_context.ml index b8733474..8eb6724b 100644 --- a/src/super_context.ml +++ b/src/super_context.ml @@ -41,6 +41,7 @@ let file_tree t = t.file_tree let stanzas_to_consider_for_install t = t.stanzas_to_consider_for_install let cxx_flags t = t.cxx_flags let build_dir t = t.context.build_dir +let build_system t = t.build_system let host t = Option.value t.host ~default:t @@ -218,10 +219,10 @@ let create let prefix_rules t prefix ~f = Build_system.prefix_rules t.build_system prefix ~f -let add_rule t ?sandbox ?mode ?locks ?loc build = +let add_rule t ?sandbox ?mode ?locks ?loc ?package build = let build = Build.O.(>>>) build t.chdir in Build_system.add_rule t.build_system - (Build_interpret.Rule.make ?sandbox ?mode ?locks ?loc + (Build_interpret.Rule.make ?sandbox ?mode ?locks ?loc ?package ~context:(Some t.context) build) let add_rule_get_targets t ?sandbox ?mode ?locks ?loc build = diff --git a/src/super_context.mli b/src/super_context.mli index 9921587c..ffd2900d 100644 --- a/src/super_context.mli +++ b/src/super_context.mli @@ -41,6 +41,7 @@ val stanzas_to_consider_for_install : t -> (Path.t * Scope.t * Stanza.t) list val cxx_flags : t -> string list val build_dir : t -> Path.t val host : t -> t +val build_system : t -> Build_system.t (** All public libraries of the workspace *) val public_libs : t -> Lib.DB.t @@ -79,6 +80,7 @@ val add_rule -> ?mode:Jbuild.Rule.Mode.t -> ?locks:Path.t list -> ?loc:Loc.t + -> ?package:Package.Name.t -> (unit, Action.t) Build.t -> unit val add_rule_get_targets From a55cde29690b1c54eaf3b39b764e9f32d4c325e2 Mon Sep 17 00:00:00 2001 From: Jeremie Dimino Date: Thu, 15 Mar 2018 19:56:03 +0000 Subject: [PATCH 07/14] fix --- src/build_interpret.ml | 4 +--- src/build_interpret.mli | 2 -- src/build_system.ml | 47 ++++++++++++++++++++++------------------- src/build_system.mli | 3 +++ src/install_rules.ml | 6 ++++-- src/super_context.ml | 4 ++-- src/super_context.mli | 1 - 7 files changed, 35 insertions(+), 32 deletions(-) diff --git a/src/build_interpret.ml b/src/build_interpret.ml index f559174d..59037a43 100644 --- a/src/build_interpret.ml +++ b/src/build_interpret.ml @@ -192,11 +192,10 @@ module Rule = struct ; locks : Path.t list ; loc : Loc.t option ; dir : Path.t - ; package : Package.Name.t option } let make ?(sandbox=false) ?(mode=Jbuild.Rule.Mode.Not_a_rule_stanza) - ~context ?(locks=[]) ?loc ?package build = + ~context ?(locks=[]) ?loc build = let targets = targets build in let dir = match targets with @@ -230,6 +229,5 @@ module Rule = struct ; locks ; loc ; dir - ; package } end diff --git a/src/build_interpret.mli b/src/build_interpret.mli index 01bf3687..5d2f08c7 100644 --- a/src/build_interpret.mli +++ b/src/build_interpret.mli @@ -20,7 +20,6 @@ module Rule : sig ; loc : Loc.t option ; (** Directory where all the targets are produced *) dir : Path.t - ; package : Package.Name.t option } val make @@ -29,7 +28,6 @@ module Rule : sig -> context:Context.t option -> ?locks:Path.t list -> ?loc:Loc.t - -> ?package:Package.Name.t -> (unit, Action.t) Build.t -> t end diff --git a/src/build_system.ml b/src/build_system.ml index 99fbaad1..30013f78 100644 --- a/src/build_system.ml +++ b/src/build_system.ml @@ -161,7 +161,6 @@ module Internal_rule = struct ; loc : Loc.t option ; dir : Path.t ; mutable exec : Exec_status.t - ; package : Package.Name.t option } let compare a b = Id.compare a.id b.id @@ -354,6 +353,8 @@ type t = ; files_of : (Path.t, Files_of.t) Hashtbl.t ; mutable prefix : (unit, unit) Build.t option ; hook : hook -> unit + ; (* Package files are part of *) + packages : (Path.t, Package.Name.t) Hashtbl.t } let string_of_paths set = @@ -652,7 +653,6 @@ let rec compile_rule t ?(copy_source=false) pre_rule = ; locks ; loc ; dir - ; package } = pre_rule in @@ -777,7 +777,6 @@ let rec compile_rule t ?(copy_source=false) pre_rule = ; mode ; loc ; dir - ; package } in create_file_specs t target_specs rule ~copy_source @@ -1150,6 +1149,7 @@ let create ~contexts ~file_tree ~hook = let t = { contexts ; files = Hashtbl.create 1024 + ; packages = Hashtbl.create 1024 ; trace = Trace.load () ; local_mkdirs = Path.Local.Set.empty ; dirs = Hashtbl.create 1024 @@ -1390,30 +1390,33 @@ let build_rules ?recursive t ~request = entry_point t ~f:(fun () -> build_rules_internal ?recursive t ~request) +let set_package t file package = + Hashtbl.add t.packages file package + let package_deps t files = let rules_seen = ref Id_set.empty in let packages = ref Package.Name.Set.empty in let rec loop fn = - let dir = Path.parent fn in - if Path.is_in_build_dir dir then load_dir t ~dir; - match Hashtbl.find t.files fn with - | None -> () - | Some (File_spec.T { rule = ir; _ }) -> - if not (Id_set.mem !rules_seen ir.id) then begin - rules_seen := Id_set.add !rules_seen ir.id; - let _, dyn_deps = - match ir.exec with - | Running { rule_evaluation; _ } - | Evaluating_rule { rule_evaluation; _ } -> - Option.value_exn (Fiber.Future.peek rule_evaluation) - | Not_started _ -> assert false - in - match ir.package with - | None -> + match Hashtbl.find t.packages fn with + | Some p -> + packages := Package.Name.Set.add !packages p + | None -> + let dir = Path.parent fn in + if Path.is_in_build_dir dir then load_dir t ~dir; + match Hashtbl.find t.files fn with + | None -> () + | Some (File_spec.T { rule = ir; _ }) -> + if not (Id_set.mem !rules_seen ir.id) then begin + rules_seen := Id_set.add !rules_seen ir.id; + let _, dyn_deps = + match ir.exec with + | Running { rule_evaluation; _ } + | Evaluating_rule { rule_evaluation; _ } -> + Option.value_exn (Fiber.Future.peek rule_evaluation) + | Not_started _ -> assert false + in Pset.iter (Pset.union ir.static_deps dyn_deps) ~f:loop - | Some p -> - packages := Package.Name.Set.add !packages p - end + end in let open Build.O in Build.paths_for_rule files >>^ fun () -> diff --git a/src/build_system.mli b/src/build_system.mli index 0a3aaea8..109e763d 100644 --- a/src/build_system.mli +++ b/src/build_system.mli @@ -77,6 +77,9 @@ val on_load_dir : t -> dir:Path.t -> f:(unit -> unit) -> unit (** Stamp file that depends on all files of [dir] with extension [ext]. *) val stamp_file_for_files_of : t -> dir:Path.t -> ext:string -> Path.t +(** Sets the package this file is part of *) +val set_package : t -> Path.t -> Package.Name.t -> unit + (** Scan the transitive dependencies of the following files and return set of packages these files are part of. Do not scan packages recursively. *) diff --git a/src/install_rules.ml b/src/install_rules.ml index 7c948d76..d4715a67 100644 --- a/src/install_rules.ml +++ b/src/install_rules.ml @@ -203,9 +203,11 @@ module Gen(P : Install_params) = struct let install_dir = Config.local_install_dir ~context:ctx.name in List.map entries ~f:(fun entry -> let dst = - Path.append install_dir (Install.Entry.relative_installed_path entry ~package) + Path.append install_dir + (Install.Entry.relative_installed_path entry ~package) in - SC.add_rule sctx (Build.symlink ~src:entry.src ~dst) ~package; + Build_system.set_package (SC.build_system sctx) entry.src package; + SC.add_rule sctx (Build.symlink ~src:entry.src ~dst); Install.Entry.set_src entry dst) let promote_install_file = diff --git a/src/super_context.ml b/src/super_context.ml index 8eb6724b..c157ae55 100644 --- a/src/super_context.ml +++ b/src/super_context.ml @@ -219,10 +219,10 @@ let create let prefix_rules t prefix ~f = Build_system.prefix_rules t.build_system prefix ~f -let add_rule t ?sandbox ?mode ?locks ?loc ?package build = +let add_rule t ?sandbox ?mode ?locks ?loc build = let build = Build.O.(>>>) build t.chdir in Build_system.add_rule t.build_system - (Build_interpret.Rule.make ?sandbox ?mode ?locks ?loc ?package + (Build_interpret.Rule.make ?sandbox ?mode ?locks ?loc ~context:(Some t.context) build) let add_rule_get_targets t ?sandbox ?mode ?locks ?loc build = diff --git a/src/super_context.mli b/src/super_context.mli index ffd2900d..a696840d 100644 --- a/src/super_context.mli +++ b/src/super_context.mli @@ -80,7 +80,6 @@ val add_rule -> ?mode:Jbuild.Rule.Mode.t -> ?locks:Path.t list -> ?loc:Loc.t - -> ?package:Package.Name.t -> (unit, Action.t) Build.t -> unit val add_rule_get_targets From 9043280160b8c244cb723eaaed76b2bdbdcf3b68 Mon Sep 17 00:00:00 2001 From: Jeremie Dimino Date: Thu, 15 Mar 2018 21:13:41 +0000 Subject: [PATCH 08/14] Allow dynamic dependencies for aliases --- src/build_system.ml | 39 ++++++++++++++++++++++++++++----------- src/build_system.mli | 12 +++++++++--- src/super_context.ml | 4 ++-- src/super_context.mli | 1 + 4 files changed, 40 insertions(+), 16 deletions(-) diff --git a/src/build_system.ml b/src/build_system.ml index 30013f78..56db501d 100644 --- a/src/build_system.ml +++ b/src/build_system.ml @@ -301,8 +301,9 @@ module Dir_status = struct type alias = - { mutable deps : Pset.t - ; mutable actions : alias_action list + { mutable deps : Pset.t + ; mutable dyn_deps : (unit, Path.t list) Build.t + ; mutable actions : alias_action list } type rules_collector = @@ -858,7 +859,7 @@ and load_dir_step2_exn t ~dir ~collector ~lazy_generators = let alias_rules, alias_stamp_files = let open Build.O in String_map.foldi collector.aliases ~init:([], Pset.empty) - ~f:(fun name { Dir_status. deps; actions } (rules, alias_stamp_files) -> + ~f:(fun name { Dir_status. deps; dyn_deps; actions } (rules, alias_stamp_files) -> let base_path = Path.relative alias_dir name in let rules, deps = List.fold_left actions ~init:(rules, deps) @@ -878,11 +879,14 @@ and load_dir_step2_exn t ~dir ~collector ~lazy_generators = (Pre_rule.make ~context:None (Build.path_set deps >>> - Build.action ~targets:[path] - (Redirect (Stdout, - path, - Digest_files - (Path.Set.to_list deps)))) + dyn_deps >>> + Build.dyn_paths (Build.arr (fun x -> x)) + >>^ (fun dyn_deps -> + let deps = Pset.union deps (Pset.of_list dyn_deps) in + Action.with_stdout_to path + (Action.digest_files (Pset.to_list deps))) + >>> + Build.action_dyn () ~targets:[path]) :: rules, Pset.add alias_stamp_files path)) in @@ -1516,14 +1520,27 @@ module Alias = struct let collector = get_collector build_system ~dir:t.dir in match String_map.find collector.aliases t.name with | None -> - let x = { Dir_status. deps = Pset.empty; actions = [] } in + let x = + { Dir_status. + deps = Pset.empty + ; dyn_deps = Build.return [] + ; actions = [] + } + in collector.aliases <- String_map.add collector.aliases t.name x; x | Some x -> x - let add_deps build_system t deps = + let add_deps build_system t ?dyn_deps deps = let def = get_alias_def build_system t in - def.deps <- Pset.union def.deps (Pset.of_list deps) + def.deps <- Pset.union def.deps (Pset.of_list deps); + match dyn_deps with + | None -> () + | Some build -> + let open Build.O in + def.dyn_deps <- + Build.fanout def.dyn_deps build >>^ fun (a, b) -> + List.rev_append a b let add_action build_system t ~context ?(locks=[]) ~stamp action = let def = get_alias_def build_system t in diff --git a/src/build_system.mli b/src/build_system.mli index 109e763d..752cb737 100644 --- a/src/build_system.mli +++ b/src/build_system.mli @@ -143,9 +143,15 @@ module Alias : sig -> contexts:string list -> (unit, unit) Build.t - (** [add_deps store alias deps] arrange things so that all [deps] - are built as part of the build of alias [alias]. *) - val add_deps : build_system -> t -> Path.t list -> unit + (** [add_deps store alias ?dyn_deps deps] arrange things so that all + [dyn_deps] and [deps] are built as part of the build of alias + [alias]. *) + val add_deps + : build_system + -> t + -> ?dyn_deps:(unit, Path.t list) Build.t + -> Path.t list + -> unit (** [add_action store alias ~stamp action] arrange things so that [action] is executed as part of the build of alias diff --git a/src/super_context.ml b/src/super_context.ml index c157ae55..c9dfaf2d 100644 --- a/src/super_context.ml +++ b/src/super_context.ml @@ -237,8 +237,8 @@ let add_rule_get_targets t ?sandbox ?mode ?locks ?loc build = let add_rules t ?sandbox builds = List.iter builds ~f:(add_rule t ?sandbox) -let add_alias_deps t alias deps = - Alias.add_deps t.build_system alias deps +let add_alias_deps t alias ?dyn_deps deps = + Alias.add_deps t.build_system alias ?dyn_deps deps let add_alias_action t alias ?locks ~stamp action = Alias.add_action t.build_system ~context:t.context alias ?locks ~stamp action diff --git a/src/super_context.mli b/src/super_context.mli index a696840d..f9d5ab08 100644 --- a/src/super_context.mli +++ b/src/super_context.mli @@ -98,6 +98,7 @@ val add_rules val add_alias_deps : t -> Build_system.Alias.t + -> ?dyn_deps:(unit, Path.t list) Build.t -> Path.t list -> unit val add_alias_action From 30c59cc476bdf5d6a9b8d6d1342094b3a64f4e9f Mon Sep 17 00:00:00 2001 From: Jeremie Dimino Date: Thu, 15 Mar 2018 21:15:16 +0000 Subject: [PATCH 09/14] Use dynamic dependencies for the package deps --- src/install_rules.ml | 31 +++++++++++++------------------ 1 file changed, 13 insertions(+), 18 deletions(-) diff --git a/src/install_rules.ml b/src/install_rules.ml index d4715a67..c3a806e1 100644 --- a/src/install_rules.ml +++ b/src/install_rules.ml @@ -239,24 +239,19 @@ module Gen(P : Install_params) = struct (Utils.install_file ~package ~findlib_toolchain:ctx.findlib_toolchain) in let entries = local_install_rules entries ~package in - SC.add_alias_action sctx ~stamp:(List []) + let files = Install.files entries in + SC.add_alias_deps sctx (Alias.package_install ~context:ctx ~pkg:package) - (let files = - List.map entries ~f:(fun (e : Install.Entry.t) -> e.src) - |> Path.Set.of_list - in - Build.path_set files - >>> - Build_system.package_deps (SC.build_system sctx) files - >>> - Build.dyn_paths (Build.arr (fun packages -> - Package.Name.Set.remove packages package - |> Package.Name.Set.to_list - |> List.map ~f:(fun pkg -> - Build_system.Alias.package_install - ~context:(SC.context sctx) ~pkg - |> Build_system.Alias.stamp_file))) - >>^ fun _ -> Action.Progn []); + (Path.Set.to_list files) + ~dyn_deps: + (Build_system.package_deps (SC.build_system sctx) files + >>^ fun packages -> + Package.Name.Set.remove packages package + |> Package.Name.Set.to_list + |> List.map ~f:(fun pkg -> + Build_system.Alias.package_install + ~context:(SC.context sctx) ~pkg + |> Build_system.Alias.stamp_file)); SC.add_rule sctx ~mode:(if promote_install_file then Promote_but_delete_on_clean @@ -264,7 +259,7 @@ module Gen(P : Install_params) = struct (* We must ignore the source file since it might be copied to the source tree by another context. *) Ignore_source_files) - (Build.path_set (Install.files entries) + (Build.path_set files >>^ (fun () -> let entries = match ctx.findlib_toolchain with From b5fad14f1600d789e04b941fcc8f72db035694e9 Mon Sep 17 00:00:00 2001 From: Jeremie Dimino Date: Thu, 15 Mar 2018 21:22:13 +0000 Subject: [PATCH 10/14] Less Path.Set.t -> Path.t list conversions --- src/build.ml | 5 +++-- src/build.mli | 3 ++- src/build_system.ml | 14 +++++++------- src/build_system.mli | 4 ++-- src/gen_rules.ml | 7 ++++--- src/install_rules.ml | 7 ++++--- src/odoc.ml | 15 +++++++++------ src/super_context.ml | 3 ++- src/super_context.mli | 6 +++--- 9 files changed, 36 insertions(+), 28 deletions(-) diff --git a/src/build.ml b/src/build.ml index 32e1f912..60a5fb1e 100644 --- a/src/build.ml +++ b/src/build.ml @@ -34,7 +34,7 @@ module Repr = struct | Contents : Path.t -> ('a, string) t | Lines_of : Path.t -> ('a, string list) t | Vpath : 'a Vspec.t -> (unit, 'a) t - | Dyn_paths : ('a, Path.t list) t -> ('a, 'a) t + | Dyn_paths : ('a, Path.Set.t) t -> ('a, 'a) t | Record_lib_deps : lib_deps -> ('a, 'a) t | Fail : fail -> (_, _) t | Memo : 'a memo -> (unit, 'a) t @@ -135,7 +135,8 @@ let paths ps = Paths (Pset.of_list ps) let path_set ps = Paths ps let paths_glob ~loc ~dir re = Paths_glob (ref (G_unevaluated (loc, dir, re))) let vpath vp = Vpath vp -let dyn_paths t = Dyn_paths t +let dyn_paths t = Dyn_paths (t >>^ Path.Set.of_list) +let dyn_path_set t = Dyn_paths t let paths_for_rule ps = Paths_for_rule ps let catch t ~on_error = Catch (t, on_error) diff --git a/src/build.mli b/src/build.mli index d8c704d7..7a73a3c1 100644 --- a/src/build.mli +++ b/src/build.mli @@ -71,6 +71,7 @@ val files_recursively_in (** Record dynamic dependencies *) val dyn_paths : ('a, Path.t list) t -> ('a, 'a) t +val dyn_path_set : ('a, Path.Set.t) t -> ('a, 'a) t val vpath : 'a Vspec.t -> (unit, 'a) t @@ -189,7 +190,7 @@ module Repr : sig | Contents : Path.t -> ('a, string) t | Lines_of : Path.t -> ('a, string list) t | Vpath : 'a Vspec.t -> (unit, 'a) t - | Dyn_paths : ('a, Path.t list) t -> ('a, 'a) t + | Dyn_paths : ('a, Path.Set.t) t -> ('a, 'a) t | Record_lib_deps : lib_deps -> ('a, 'a) t | Fail : fail -> (_, _) t | Memo : 'a memo -> (unit, 'a) t diff --git a/src/build_system.ml b/src/build_system.ml index 56db501d..515707e3 100644 --- a/src/build_system.ml +++ b/src/build_system.ml @@ -302,7 +302,7 @@ module Dir_status = struct type alias = { mutable deps : Pset.t - ; mutable dyn_deps : (unit, Path.t list) Build.t + ; mutable dyn_deps : (unit, Pset.t) Build.t ; mutable actions : alias_action list } @@ -458,7 +458,7 @@ module Build_exec = struct Option.value_exn file.data | Dyn_paths t -> let fns = exec dyn_deps t x in - dyn_deps := Pset.union !dyn_deps (Pset.of_list fns); + dyn_deps := Pset.union !dyn_deps fns; x | Record_lib_deps _ -> x | Fail { fail } -> fail () @@ -880,9 +880,9 @@ and load_dir_step2_exn t ~dir ~collector ~lazy_generators = ~context:None (Build.path_set deps >>> dyn_deps >>> - Build.dyn_paths (Build.arr (fun x -> x)) + Build.dyn_path_set (Build.arr (fun x -> x)) >>^ (fun dyn_deps -> - let deps = Pset.union deps (Pset.of_list dyn_deps) in + let deps = Pset.union deps dyn_deps in Action.with_stdout_to path (Action.digest_files (Pset.to_list deps))) >>> @@ -1523,7 +1523,7 @@ module Alias = struct let x = { Dir_status. deps = Pset.empty - ; dyn_deps = Build.return [] + ; dyn_deps = Build.return Pset.empty ; actions = [] } in @@ -1533,14 +1533,14 @@ module Alias = struct let add_deps build_system t ?dyn_deps deps = let def = get_alias_def build_system t in - def.deps <- Pset.union def.deps (Pset.of_list deps); + def.deps <- Pset.union def.deps deps; match dyn_deps with | None -> () | Some build -> let open Build.O in def.dyn_deps <- Build.fanout def.dyn_deps build >>^ fun (a, b) -> - List.rev_append a b + Pset.union a b let add_action build_system t ~context ?(locks=[]) ~stamp action = let def = get_alias_def build_system t in diff --git a/src/build_system.mli b/src/build_system.mli index 752cb737..61b66247 100644 --- a/src/build_system.mli +++ b/src/build_system.mli @@ -149,8 +149,8 @@ module Alias : sig val add_deps : build_system -> t - -> ?dyn_deps:(unit, Path.t list) Build.t - -> Path.t list + -> ?dyn_deps:(unit, Path.Set.t) Build.t + -> Path.Set.t -> unit (** [add_action store alias ~stamp action] arrange things so that diff --git a/src/gen_rules.ml b/src/gen_rules.ml index ef0694a5..201c684e 100644 --- a/src/gen_rules.ml +++ b/src/gen_rules.ml @@ -708,17 +708,18 @@ module Gen(P : Install_rules.Params) = struct List.iter Cm_kind.all ~f:(fun cm_kind -> let files = - Module.Name.Map.fold modules ~init:[] ~f:(fun m acc -> + Module.Name.Map.fold modules ~init:Path.Set.empty ~f:(fun m acc -> match Module.cm_file m ~obj_dir cm_kind with | None -> acc - | Some fn -> fn :: acc) + | Some fn -> Path.Set.add acc fn) in SC.Libs.setup_file_deps_alias sctx ~dir lib ~ext:(Cm_kind.ext cm_kind) files); SC.Libs.setup_file_deps_group_alias sctx ~dir lib ~exts:[".cmi"; ".cmx"]; SC.Libs.setup_file_deps_alias sctx ~dir lib ~ext:".h" (List.map lib.install_c_headers ~f:(fun header -> - Path.relative dir (header ^ ".h"))); + Path.relative dir (header ^ ".h")) + |> Path.Set.of_list); let top_sorted_modules = Ocamldep.Dep_graph.top_closed_implementations dep_graphs.impl diff --git a/src/install_rules.ml b/src/install_rules.ml index c3a806e1..448f22af 100644 --- a/src/install_rules.ml +++ b/src/install_rules.ml @@ -242,7 +242,7 @@ module Gen(P : Install_params) = struct let files = Install.files entries in SC.add_alias_deps sctx (Alias.package_install ~context:ctx ~pkg:package) - (Path.Set.to_list files) + files ~dyn_deps: (Build_system.package_deps (SC.build_system sctx) files >>^ fun packages -> @@ -251,7 +251,8 @@ module Gen(P : Install_params) = struct |> List.map ~f:(fun pkg -> Build_system.Alias.package_install ~context:(SC.context sctx) ~pkg - |> Build_system.Alias.stamp_file)); + |> Build_system.Alias.stamp_file) + |> Path.Set.of_list); SC.add_rule sctx ~mode:(if promote_install_file then Promote_but_delete_on_clean @@ -314,7 +315,7 @@ module Gen(P : Install_params) = struct let path = Path.append ctx.build_dir src_path in let install_alias = Alias.install ~dir:path in let install_file = Path.relative path install_fn in - SC.add_alias_deps sctx install_alias [install_file]) + SC.add_alias_deps sctx install_alias (Path.Set.singleton install_file)) let init () = init_meta (); diff --git a/src/odoc.ml b/src/odoc.ml index ee8b4a19..131093d1 100644 --- a/src/odoc.ml +++ b/src/odoc.ml @@ -210,7 +210,8 @@ module Gen (S : sig val sctx : SC.t end) = struct compile_module ~dir ~obj_dir ~includes ~dep_graphs ~doc_dir ~pkg_or_lnu) in - Dep.setup_deps (Lib lib) (List.map modules_and_odoc_files ~f:snd) + Dep.setup_deps (Lib lib) (List.map modules_and_odoc_files ~f:snd + |> Path.Set.of_list) let setup_css_rule () = SC.add_rule sctx @@ -337,13 +338,13 @@ module Gen (S : sig val sctx : SC.t end) = struct :: List.map ~f:(fun lib -> Dep.html_alias (Lib lib)) libs ) ~f:(fun alias -> SC.add_alias_deps sctx alias - [ css_file - ; toplevel_index - ] + (Path.Set.of_list [ css_file + ; toplevel_index + ]) ); List.combine odocs html_files |> List.iter ~f:(fun (odoc, html) -> - SC.add_alias_deps sctx odoc.html_alias [html] + SC.add_alias_deps sctx odoc.html_alias (Path.Set.singleton html) ); end @@ -387,6 +388,7 @@ module Gen (S : sig val sctx : SC.t end) = struct |> Lib.Set.to_list |> List.map ~f:(fun lib -> Dep.html_alias (Lib lib))) |> List.map ~f:Build_system.Alias.stamp_file + |> Path.Set.of_list ) let pkg_odoc (pkg : Package.t) = Paths.odocs (Pkg pkg.name) @@ -449,7 +451,7 @@ module Gen (S : sig val sctx : SC.t end) = struct ~doc_dir:(Paths.odocs (Pkg pkg.name)) ~includes:(Build.arr (fun _ -> Arg_spec.As [])) ) in - Dep.setup_deps (Pkg pkg.name) odocs + Dep.setup_deps (Pkg pkg.name) (Path.Set.of_list odocs) let init ~modules_by_lib ~mlds_of_dir = let docs_by_package = @@ -529,6 +531,7 @@ module Gen (S : sig val sctx : SC.t end) = struct )) |> List.map ~f:(fun (lib : Lib.t) -> Build_system.Alias.stamp_file (Dep.alias (Lib lib))) + |> Path.Set.of_list ) end diff --git a/src/super_context.ml b/src/super_context.ml index c9dfaf2d..0387b65b 100644 --- a/src/super_context.ml +++ b/src/super_context.ml @@ -303,7 +303,8 @@ module Libs = struct ~ext:(String.concat exts ~sep:"-and-") (List.map exts ~f:(fun ext -> Alias.stamp_file - (lib_files_alias ~dir ~name:(Library.best_name lib) ~ext))) + (lib_files_alias ~dir ~name:(Library.best_name lib) ~ext)) + |> Path.Set.of_list) let file_deps t ~ext = Build.dyn_paths (Build.arr (fun libs -> diff --git a/src/super_context.mli b/src/super_context.mli index f9d5ab08..dd6ded0f 100644 --- a/src/super_context.mli +++ b/src/super_context.mli @@ -98,8 +98,8 @@ val add_rules val add_alias_deps : t -> Build_system.Alias.t - -> ?dyn_deps:(unit, Path.t list) Build.t - -> Path.t list + -> ?dyn_deps:(unit, Path.Set.t) Build.t + -> Path.Set.t -> unit val add_alias_action : t @@ -152,7 +152,7 @@ module Libs : sig -> dir:Path.t -> ext:string -> Library.t - -> Path.t list + -> Path.Set.t -> unit (** Setup an alias that depend on all files with the given extensions. From a729409fa7fe5aa390073cd202d34500d35f23f1 Mon Sep 17 00:00:00 2001 From: Jeremie Dimino Date: Sun, 18 Mar 2018 06:27:11 -0400 Subject: [PATCH 11/14] Update the package-dep test to test dependencies between packages --- .../package-dep/{foo.ml => bar.opam} | 0 .../test-cases/package-dep/jbuild | 32 ++++++++++++++++--- .../test-cases/package-dep/run.t | 14 +++++--- 3 files changed, 37 insertions(+), 9 deletions(-) rename test/blackbox-tests/test-cases/package-dep/{foo.ml => bar.opam} (100%) diff --git a/test/blackbox-tests/test-cases/package-dep/foo.ml b/test/blackbox-tests/test-cases/package-dep/bar.opam similarity index 100% rename from test/blackbox-tests/test-cases/package-dep/foo.ml rename to test/blackbox-tests/test-cases/package-dep/bar.opam diff --git a/test/blackbox-tests/test-cases/package-dep/jbuild b/test/blackbox-tests/test-cases/package-dep/jbuild index b1117511..30d1761f 100644 --- a/test/blackbox-tests/test-cases/package-dep/jbuild +++ b/test/blackbox-tests/test-cases/package-dep/jbuild @@ -1,11 +1,33 @@ (jbuild_version 1) (library - ((name foo) + ((name foo) (public_name foo) - (modules (foo)))) + (modules (foo)))) + +(library + ((name bar) + (public_name bar) + (libraries (foo)) + (modules (bar)))) + +(rule + (with-stdout-to foo.ml + (echo "let x = 42"))) + +(rule + (with-stdout-to bar.ml + (echo "let x = string_of_int Foo.x"))) + +(rule + (with-stdout-to test.ml + (echo "let () = Printf.printf \"%d %s\" Foo.x Bar.x"))) + +(rule + ((deps ((package bar))) + (targets (test.exe)) + (action (run ocamlfind ocamlc -linkpkg -package bar -o test.exe test.ml)))) (alias - ((name runtest) - (deps ((package foo))) - (action (echo "package foo")))) + ((name runtest) + (action (run ./test.exe)))) diff --git a/test/blackbox-tests/test-cases/package-dep/run.t b/test/blackbox-tests/test-cases/package-dep/run.t index 08c9309d..a3fa2bd7 100644 --- a/test/blackbox-tests/test-cases/package-dep/run.t +++ b/test/blackbox-tests/test-cases/package-dep/run.t @@ -1,8 +1,14 @@ $ $JBUILDER runtest -j1 --display short --root . + ocamldep bar.ml.d ocamldep foo.ml.d ocamlc .foo.objs/foo.{cmi,cmo,cmt} + ocamlc .bar.objs/bar.{cmi,cmo,cmt} + ocamlc bar.cma ocamlopt .foo.objs/foo.{cmx,o} - ocamlopt foo.{a,cmxa} - ocamlopt foo.cmxs - ocamlc foo.cma - package foo + ocamlopt .bar.objs/bar.{cmx,o} + ocamlopt bar.{a,cmxa} + ocamlopt bar.cmxs + ocamlfind test.exe (exit 2) + (cd _build/default && /Users/rgrinberg/.opam/4.05.0/bin/ocamlfind ocamlc -linkpkg -package bar -o test.exe test.ml) + ocamlfind: Package `foo' not found - required by `bar' + [1] From c685e8ac6dae953f0392d87bf8dc498198012924 Mon Sep 17 00:00:00 2001 From: Jeremie Dimino Date: Sun, 18 Mar 2018 06:38:17 -0400 Subject: [PATCH 12/14] Remove useless load_dir --- src/build_system.ml | 43 +++++++++---------- src/build_system.mli | 7 +-- src/install_rules.ml | 5 +-- .../test-cases/package-dep/jbuild | 2 +- .../test-cases/package-dep/run.t | 10 +++-- 5 files changed, 34 insertions(+), 33 deletions(-) diff --git a/src/build_system.ml b/src/build_system.ml index 515707e3..35e03d5c 100644 --- a/src/build_system.ml +++ b/src/build_system.ml @@ -1397,36 +1397,35 @@ let build_rules ?recursive t ~request = let set_package t file package = Hashtbl.add t.packages file package -let package_deps t files = +let package_deps t pkg files = let rules_seen = ref Id_set.empty in let packages = ref Package.Name.Set.empty in let rec loop fn = match Hashtbl.find t.packages fn with - | Some p -> + | Some p when p <> pkg -> packages := Package.Name.Set.add !packages p - | None -> - let dir = Path.parent fn in - if Path.is_in_build_dir dir then load_dir t ~dir; - match Hashtbl.find t.files fn with - | None -> () - | Some (File_spec.T { rule = ir; _ }) -> - if not (Id_set.mem !rules_seen ir.id) then begin - rules_seen := Id_set.add !rules_seen ir.id; - let _, dyn_deps = - match ir.exec with - | Running { rule_evaluation; _ } - | Evaluating_rule { rule_evaluation; _ } -> - Option.value_exn (Fiber.Future.peek rule_evaluation) - | Not_started _ -> assert false - in - Pset.iter (Pset.union ir.static_deps dyn_deps) ~f:loop - end + | _ -> loop_deps fn + and loop_deps fn = + match Hashtbl.find t.files fn with + | None -> () + | Some (File_spec.T { rule = ir; _ }) -> + if not (Id_set.mem !rules_seen ir.id) then begin + rules_seen := Id_set.add !rules_seen ir.id; + let _, dyn_deps = + match ir.exec with + | Running { rule_evaluation; _ } + | Evaluating_rule { rule_evaluation; _ } -> + Option.value_exn (Fiber.Future.peek rule_evaluation) + | Not_started _ -> assert false + in + Pset.iter (Pset.union ir.static_deps dyn_deps) ~f:loop + end in let open Build.O in Build.paths_for_rule files >>^ fun () -> - (* This is a bit ugly, we know that at this point of execution, all - the relevant ivars have been filled *) - Pset.iter files ~f:loop; + (* We know that at this point of execution, all the relevant ivars + have been filled *) + Pset.iter files ~f:loop_deps; !packages (* +-----------------------------------------------------------------+ diff --git a/src/build_system.mli b/src/build_system.mli index 61b66247..82f99435 100644 --- a/src/build_system.mli +++ b/src/build_system.mli @@ -80,11 +80,12 @@ val stamp_file_for_files_of : t -> dir:Path.t -> ext:string -> Path.t (** Sets the package this file is part of *) val set_package : t -> Path.t -> Package.Name.t -> unit -(** Scan the transitive dependencies of the following files and return - set of packages these files are part of. Do not scan packages - recursively. *) +(** Assuming [files] is the list of files in [_build/install] that + belong to package [pkg], [package_deps t pkg files] is the set of + direct package dependencies of [package]. *) val package_deps : t + -> Package.Name.t -> Path.Set.t -> (unit, Package.Name.Set.t) Build.t diff --git a/src/install_rules.ml b/src/install_rules.ml index 448f22af..fed05398 100644 --- a/src/install_rules.ml +++ b/src/install_rules.ml @@ -244,10 +244,9 @@ module Gen(P : Install_params) = struct (Alias.package_install ~context:ctx ~pkg:package) files ~dyn_deps: - (Build_system.package_deps (SC.build_system sctx) files + (Build_system.package_deps (SC.build_system sctx) package files >>^ fun packages -> - Package.Name.Set.remove packages package - |> Package.Name.Set.to_list + Package.Name.Set.to_list packages |> List.map ~f:(fun pkg -> Build_system.Alias.package_install ~context:(SC.context sctx) ~pkg diff --git a/test/blackbox-tests/test-cases/package-dep/jbuild b/test/blackbox-tests/test-cases/package-dep/jbuild index 30d1761f..a311c774 100644 --- a/test/blackbox-tests/test-cases/package-dep/jbuild +++ b/test/blackbox-tests/test-cases/package-dep/jbuild @@ -24,7 +24,7 @@ (echo "let () = Printf.printf \"%d %s\" Foo.x Bar.x"))) (rule - ((deps ((package bar))) + ((deps (test.ml (package bar))) (targets (test.exe)) (action (run ocamlfind ocamlc -linkpkg -package bar -o test.exe test.ml)))) diff --git a/test/blackbox-tests/test-cases/package-dep/run.t b/test/blackbox-tests/test-cases/package-dep/run.t index a3fa2bd7..1a4e219c 100644 --- a/test/blackbox-tests/test-cases/package-dep/run.t +++ b/test/blackbox-tests/test-cases/package-dep/run.t @@ -8,7 +8,9 @@ ocamlopt .bar.objs/bar.{cmx,o} ocamlopt bar.{a,cmxa} ocamlopt bar.cmxs - ocamlfind test.exe (exit 2) - (cd _build/default && /Users/rgrinberg/.opam/4.05.0/bin/ocamlfind ocamlc -linkpkg -package bar -o test.exe test.ml) - ocamlfind: Package `foo' not found - required by `bar' - [1] + ocamlopt foo.{a,cmxa} + ocamlopt foo.cmxs + ocamlc foo.cma + ocamlfind test.exe + test alias runtest + 42 42 From 2c59032181a6f6afe2acdf90734eca41384e89ac Mon Sep 17 00:00:00 2001 From: Jeremie Dimino Date: Sun, 18 Mar 2018 08:37:15 -0400 Subject: [PATCH 13/14] A file might be part of several packages --- src/build_system.ml | 30 ++++++++++++++++++------------ 1 file changed, 18 insertions(+), 12 deletions(-) diff --git a/src/build_system.ml b/src/build_system.ml index 35e03d5c..09eb0825 100644 --- a/src/build_system.ml +++ b/src/build_system.ml @@ -1399,17 +1399,24 @@ let set_package t file package = let package_deps t pkg files = let rules_seen = ref Id_set.empty in - let packages = ref Package.Name.Set.empty in - let rec loop fn = - match Hashtbl.find t.packages fn with - | Some p when p <> pkg -> - packages := Package.Name.Set.add !packages p - | _ -> loop_deps fn - and loop_deps fn = + let rec loop fn acc = + match Hashtbl.find_all t.packages fn with + | [] -> loop_deps fn acc + | [p] when p = pkg -> loop_deps fn acc + | pkgs -> + List.fold_left pkgs ~init:acc ~f:add_package + and add_package acc p = + if p = pkg then + acc + else + Package.Name.Set.add acc p + and loop_deps fn acc = match Hashtbl.find t.files fn with - | None -> () + | None -> acc | Some (File_spec.T { rule = ir; _ }) -> - if not (Id_set.mem !rules_seen ir.id) then begin + if Id_set.mem !rules_seen ir.id then + acc + else begin rules_seen := Id_set.add !rules_seen ir.id; let _, dyn_deps = match ir.exec with @@ -1418,15 +1425,14 @@ let package_deps t pkg files = Option.value_exn (Fiber.Future.peek rule_evaluation) | Not_started _ -> assert false in - Pset.iter (Pset.union ir.static_deps dyn_deps) ~f:loop + Pset.fold (Pset.union ir.static_deps dyn_deps) ~init:acc ~f:loop end in let open Build.O in Build.paths_for_rule files >>^ fun () -> (* We know that at this point of execution, all the relevant ivars have been filled *) - Pset.iter files ~f:loop_deps; - !packages + Pset.fold files ~init:Package.Name.Set.empty ~f:loop_deps (* +-----------------------------------------------------------------+ | Adding rules to the system | From f26615e5b3c23d1c85a8ef9af46e290e44dd44de Mon Sep 17 00:00:00 2001 From: Jeremie Dimino Date: Sun, 18 Mar 2018 08:40:41 -0400 Subject: [PATCH 14/14] doc --- doc/jbuild.rst | 3 +++ 1 file changed, 3 insertions(+) diff --git a/doc/jbuild.rst b/doc/jbuild.rst index 0f43a835..1d229a1c 100644 --- a/doc/jbuild.rst +++ b/doc/jbuild.rst @@ -1058,6 +1058,9 @@ syntax: universe. In any case, this is only for dependencies in the installed world, you must still specify all dependencies that come from the workspace. +- ``(package )`` depend on all files installed by ````, as well + as on the transitive package dependencies of ````. This can be used + to test a command against the files that will be installed In all these cases, the argument supports `Variables expansion`_.