Register more dependencies statically

CHANGES.md

@@ -39,6 +39,9 @@ next
 - Fix error messaage when a public library is defined twice. Before
   jbuilder would raise an uncaught exception (Fixes #661, @diml)
 
+- Fix several cases where `external-lib-deps` was returning too little
+  dependencies (#667, fixes #644 @diml)
+
 1.0+beta19.1 (21/03/2018)
 -------------------------
 

bin/main.ml

@@ -72,12 +72,12 @@ let restore_cwd_and_execve common prog argv env =
 module Main = struct
   include Jbuilder.Main
 
-  let setup ~log ?filter_out_optional_stanzas_with_missing_deps common =
+  let setup ~log ?external_lib_deps_mode common =
     setup
       ~log
       ?workspace_file:common.workspace_file
       ?only_packages:common.only_packages
-      ?filter_out_optional_stanzas_with_missing_deps
+      ?external_lib_deps_mode
       ?x:common.x
       ~ignore_promoted_rules:common.ignore_promoted_rules
       ~capture_outputs:common.capture_outputs
@@ -752,7 +752,7 @@ let external_lib_deps =
     set_common common ~targets:[];
     let log = Log.create common in
     Scheduler.go ~log ~common
-      (Main.setup ~log common ~filter_out_optional_stanzas_with_missing_deps:false
+      (Main.setup ~log common ~external_lib_deps_mode:true
        >>= fun setup ->
        let targets = resolve_targets_exn ~log common setup targets in
        let request = request_of_targets setup targets in
@@ -858,7 +858,7 @@ let rules =
     set_common common ~targets;
     let log = Log.create common in
     Scheduler.go ~log ~common
-      (Main.setup ~log common ~filter_out_optional_stanzas_with_missing_deps:false
+      (Main.setup ~log common ~external_lib_deps_mode:true
        >>= fun setup ->
        let request =
          match targets with

src/arg_spec.ml

@@ -12,13 +12,15 @@ type 'a t =
   | Target   of Path.t
   | Path     of Path.t
   | Paths    of Path.t list
+  | Hidden_deps of Path.t list
   | Dyn      of ('a -> nothing t)
 
 let rec add_deps ts set =
   List.fold_left ts ~init:set ~f:(fun set t ->
     match t with
-    | Dep  fn  -> Pset.add set fn
-    | Deps fns -> Pset.union set (Pset.of_list fns)
+    | Dep fn -> Pset.add set fn
+    | Deps        fns
+    | Hidden_deps fns -> Pset.union set (Pset.of_list fns)
     | S ts
     | Concat (_, ts) -> add_deps ts set
     | _ -> set)
@@ -51,6 +53,9 @@ let expand ~dir ts x =
     | Concat (sep, ts) -> [String.concat ~sep (loop_dyn (S ts))]
     | Target _ -> die "Target not allowed under Dyn"
     | Dyn _ -> assert false
+    | Hidden_deps l ->
+      dyn_deps := Pset.union !dyn_deps (Pset.of_list l);
+      []
   in
   let rec loop = function
     | A s  -> [s]
@@ -61,6 +66,7 @@ let expand ~dir ts x =
     | Concat (sep, ts) -> [String.concat ~sep (loop (S ts))]
     | Target fn -> [Path.reach fn ~from:dir]
     | Dyn f -> loop_dyn (f x)
+    | Hidden_deps _ -> []
   in
   let l = List.concat_map ts ~f:loop in
   (l, !dyn_deps)

src/arg_spec.mli

@@ -38,6 +38,8 @@ type 'a t =
   | Target   of Path.t
   | Path     of Path.t
   | Paths    of Path.t list
+  | Hidden_deps of Path.t list
+  (** Register dependencies but produce no argument *)
   | Dyn      of ('a -> nothing t)
 
 val add_deps    : _ t list -> Path.Set.t -> Path.Set.t

src/cm_kind.ml

@@ -28,4 +28,10 @@ module Dict = struct
     ; cmo = f ~cm_kind:Cmo
     ; cmx = f ~cm_kind:Cmx
     }
+
+  let make_all x =
+    { cmi = x
+    ; cmo = x
+    ; cmx = x
+    }
 end

src/cm_kind.mli

@@ -17,4 +17,6 @@ module Dict : sig
   val get : 'a t -> cm_kind -> 'a
 
   val of_func : (cm_kind:cm_kind -> 'a) -> 'a t
+
+  val make_all : 'a -> 'a t
 end with type cm_kind := t

src/exe.ml

@@ -137,40 +137,41 @@ let link_exe
         artifacts modules ~ext:ctx.ext_obj))
   in
   SC.add_rule sctx
-    (Build.fanout4
-       requires
+    (Build.fanout3
        (register_native_objs_deps modules_and_cm_files >>^ snd)
        (Ocaml_flags.get flags mode)
        link_flags
      >>>
-     Build.dyn_paths (Build.arr (fun (libs, _, _, _) ->
-       Lib.L.archive_files libs ~mode ~ext_lib:ctx.ext_lib))
+     Build.of_result_map requires ~f:(fun libs ->
+       Build.paths (Lib.L.archive_files libs ~mode ~ext_lib:ctx.ext_lib))
      >>>
      Build.run ~context:ctx
        (Ok compiler)
-       [ Dyn (fun (_, _, flags,_) -> As flags)
+       [ Dyn (fun (_, flags,_) -> As flags)
        ; A "-o"; Target exe
        ; As linkage.flags
-       ; Dyn (fun (_, _, _, link_flags) -> As link_flags)
-       ; Dyn (fun (libs, _, _, _) ->
+       ; Dyn (fun (_, _, link_flags) -> As link_flags)
+       ; Arg_spec.of_result_map requires ~f:(fun libs ->
            Lib.L.link_flags libs ~mode ~stdlib_dir:ctx.stdlib_dir)
-       ; Dyn (fun (_, cm_files, _, _) -> Deps cm_files)
+       ; Dyn (fun (cm_files, _, _) -> Deps cm_files)
        ]);
   if linkage.ext = ".bc" then
-    let rules = Js_of_ocaml_rules.build_exe sctx ~dir ~js_of_ocaml ~src:exe in
-    let libs_and_cm_and_flags =
-      (requires &&& (modules_and_cm_files >>^ snd))
-      &&&
-      SC.expand_and_eval_set sctx ~scope ~dir js_of_ocaml.flags
-        ~standard:(Js_of_ocaml_rules.standard ())
+    let rules =
+      Js_of_ocaml_rules.build_exe sctx ~dir ~js_of_ocaml ~src:exe ~requires
     in
-    SC.add_rules sctx (List.map rules ~f:(fun r -> libs_and_cm_and_flags >>> r))
+    let cm_and_flags =
+      Build.fanout
+        (modules_and_cm_files >>^ snd)
+        (SC.expand_and_eval_set sctx ~scope ~dir js_of_ocaml.flags
+           ~standard:(Js_of_ocaml_rules.standard ()))
+    in
+    SC.add_rules sctx (List.map rules ~f:(fun r -> cm_and_flags >>> r))
 
 let build_and_link_many
       ~dir ~obj_dir ~programs ~modules
       ~scope
       ~linkages
-      ?(requires=Build.return [])
+      ?(requires=Ok [])
       ?already_used
       ?(flags=Ocaml_flags.empty)
       ?link_flags

src/exe.mli

@@ -1,5 +1,7 @@
 (** Compilation and linking of executables *)
 
+open Import
+
 module Program : sig
   type t =
     { name             : string
@@ -43,7 +45,7 @@ val build_and_link
   -> modules:Module.t Module.Name.Map.t
   -> scope:Scope.t
   -> linkages:Linkage.t list
-  -> ?requires:(unit, Lib.L.t) Build.t
+  -> ?requires:Lib.t list Or_exn.t
   -> ?already_used:Module.Name.Set.t
   -> ?flags:Ocaml_flags.t
   -> ?link_flags:(unit, string list) Build.t
@@ -58,7 +60,7 @@ val build_and_link_many
   -> modules:Module.t Module.Name.Map.t
   -> scope:Scope.t
   -> linkages:Linkage.t list
-  -> ?requires:(unit, Lib.L.t) Build.t
+  -> ?requires:Lib.t list Or_exn.t
   -> ?already_used:Module.Name.Set.t
   -> ?flags:Ocaml_flags.t
   -> ?link_flags:(unit, string list) Build.t
@@ -73,7 +75,7 @@ val link_exe
   :  dir:Path.t
   -> obj_dir:Path.t
   -> scope:Scope.t
-  -> requires:(unit, Lib.t list) Build.t
+  -> requires:Lib.t list Or_exn.t
   -> name:string
   -> linkage:Linkage.t
   -> top_sorted_modules:(unit, Module.t list) Build.t

src/findlib.ml

@@ -174,6 +174,19 @@ let root_package_name s =
   | None -> s
   | Some i -> String.sub s ~pos:0 ~len:i
 
+let dummy_package t ~name =
+  let dir =
+    match t.path with
+    | [] -> t.stdlib_dir
+    | dir :: _ -> Path.relative dir (root_package_name name)
+  in
+  { Package.
+    meta_file = Path.relative dir "META"
+  ; name      = name
+  ; dir       = dir
+  ; vars      = String_map.empty
+  }
+
 (* Parse a single package from a META file *)
 let parse_package t ~meta_file ~name ~parent_dir ~vars =
   let pkg_dir = Vars.get vars "directory" Ps.empty in

src/findlib.mli

@@ -55,6 +55,9 @@ val all_packages  : t -> Package.t list
 (** List all the packages that are not available in this database *)
 val all_unavailable_packages : t -> (string * Unavailable_reason.t) list
 
+(** A dummy package. This is used to implement [external-lib-deps] *)
+val dummy_package : t -> name:string -> Package.t
+
 module Config : sig
   type t
   val load : Path.t -> toolchain:string -> context:string -> t