diff --git a/src/artifacts.ml b/src/artifacts.ml index d5fba77b..6d67757e 100644 --- a/src/artifacts.ml +++ b/src/artifacts.ml @@ -58,7 +58,7 @@ let binary t name = die "Program %s not found in the tree or in the PATH" name } -let file_of_lib ?(use_provides=false) t ~lib ~file = +let file_of_lib ?(use_provides=false) t ~from ~lib ~file = match String_map.find lib t.local_libs with | Some { package; sub_dir; _ } -> let lib_install_dir = @@ -71,7 +71,9 @@ let file_of_lib ?(use_provides=false) t ~lib ~file = in Ok (Path.relative lib_install_dir file) | None -> - match Findlib.find t.context.findlib lib with + match + Findlib.find t.context.findlib lib ~required_by:[Utils.jbuild_name_in ~dir:from] + with | Some pkg -> Ok (Path.relative pkg.dir file) | None -> @@ -85,5 +87,7 @@ let file_of_lib ?(use_provides=false) t ~lib ~file = | None -> Error { fail = fun () -> - die "Library %s not found in the tree or in the PATH" lib + die + "Library %s not found in the tree or in the installed world" + lib } diff --git a/src/artifacts.mli b/src/artifacts.mli index fa303fec..9dce5e1c 100644 --- a/src/artifacts.mli +++ b/src/artifacts.mli @@ -11,6 +11,7 @@ val binary : t -> string -> (Path.t, fail) result val file_of_lib : ?use_provides:bool -> t + -> from:Path.t -> lib:string -> file:string -> (Path.t, fail) result diff --git a/src/config.mli b/src/config.mli index 95b5394b..df18701d 100644 --- a/src/config.mli +++ b/src/config.mli @@ -10,3 +10,4 @@ val local_install_man_dir : context:string -> Path.t val local_install_lib_dir : context:string -> package:string -> Path.t val dev_null : Path.t + diff --git a/src/findlib.ml b/src/findlib.ml index 562824eb..8113c0ab 100644 --- a/src/findlib.ml +++ b/src/findlib.ml @@ -242,7 +242,8 @@ let root_package_name s = | None -> s | Some i -> String.sub s ~pos:0 ~len:i -let rec load_meta_rec t root_name ~packages ~required_by = +let rec load_meta_rec t ~fq_name ~packages ~required_by = + let root_name = root_package_name fq_name in if String_map.mem root_name packages || Hashtbl.mem t.packages root_name then packages @@ -263,6 +264,12 @@ let rec load_meta_rec t root_name ~packages ~required_by = match String_map.find root_name Meta.builtins with | Some meta -> (t.stdlib_dir, meta) | None -> + let required_by = + if root_name = fq_name then + required_by + else + fq_name :: required_by + in raise (Package_not_found { package = root_name ; required_by }) @@ -277,17 +284,16 @@ let rec load_meta_rec t root_name ~packages ~required_by = List.fold_left new_packages ~init:String_map.empty ~f:(fun acc (pkg : Pkg_step1.t) -> if pkg.exists then - let add_roots acc deps = + let add_deps acc deps = List.fold_left deps ~init:acc ~f:(fun acc dep -> - String_map.add acc ~key:(root_package_name dep) - ~data:pkg.package.name) + String_map.add acc ~key:dep ~data:pkg.package.name) in - add_roots (add_roots acc pkg.requires) pkg.ppx_runtime_deps + add_deps (add_deps acc pkg.requires) pkg.ppx_runtime_deps else acc) in String_map.fold deps ~init:packages ~f:(fun ~key:dep ~data:package packages -> - load_meta_rec t dep ~packages ~required_by:(package :: required_by)) + load_meta_rec t ~fq_name:dep ~packages ~required_by:(package :: required_by)) module Local_closure = Top_closure.Make @@ -316,8 +322,8 @@ let remove_dups_preserve_order pkgs = loop String_set.empty pkgs [] ;; -let load_meta t root_name ~required_by = - let packages = load_meta_rec t root_name ~packages:String_map.empty ~required_by in +let load_meta t ~fq_name ~required_by = + let packages = load_meta_rec t ~fq_name ~packages:String_map.empty ~required_by in match Local_closure.top_closure packages (String_map.values packages) with | Error cycle -> die "dependency cycle detected between external findlib packages:\n %s" @@ -389,12 +395,12 @@ let load_meta t root_name ~required_by = end ) -let find_exn t name = +let find_exn t ~required_by name = match Hashtbl.find t.packages name with | Some (Present x) -> x | Some (Absent pnf) -> raise (Package_not_found pnf) | None -> - match load_meta t (root_package_name name) ~required_by:[] with + match load_meta t ~fq_name:name ~required_by with | exception (Package_not_found pnf as e) -> Hashtbl.add t.packages ~key:name ~data:(Absent pnf); raise e @@ -407,14 +413,14 @@ let find_exn t name = let pnf = { Package_not_found. package = name - ; required_by = [] + ; required_by } in Hashtbl.add t.packages ~key:name ~data:(Absent pnf); raise (Package_not_found pnf) -let find t name = - match find_exn t name with +let find t ~required_by name = + match find_exn t ~required_by name with | exception (Package_not_found _) -> None | x -> Some x @@ -449,7 +455,7 @@ let root_packages t = let all_packages t = List.iter (root_packages t) ~f:(fun pkg -> - ignore (find_exn t pkg : package)); + ignore (find_exn t pkg ~required_by:[] : package)); Hashtbl.fold t.packages ~init:[] ~f:(fun ~key:_ ~data acc -> match data with | Present p -> p :: acc diff --git a/src/findlib.mli b/src/findlib.mli index 31f0aa55..d74d2988 100644 --- a/src/findlib.mli +++ b/src/findlib.mli @@ -31,8 +31,8 @@ type package = ; has_headers : bool } -val find : t -> string -> package option -val find_exn : t -> string -> package +val find : t -> required_by:string list -> string -> package option +val find_exn : t -> required_by:string list -> string -> package val available : t -> string -> bool diff --git a/src/gen_rules.ml b/src/gen_rules.ml index d9e50f1d..32c288e7 100644 --- a/src/gen_rules.ml +++ b/src/gen_rules.ml @@ -265,7 +265,7 @@ module Gen(P : Params) = struct "invalid ${lib:...} form: %s" name | Some x -> x in - (lib, file_of_lib t ~lib ~file ?use_provides) + (lib, file_of_lib t ~from:dir ~lib ~file ?use_provides) (* Hides [t] so that we don't resolve things statically *) let t = () diff --git a/src/jbuild_load.ml b/src/jbuild_load.ml index a019d11e..abe1bdb6 100644 --- a/src/jbuild_load.ml +++ b/src/jbuild_load.ml @@ -83,7 +83,8 @@ end ~target:generated_jbuild in let pkgs = - List.map requires ~f:(Findlib.find_exn context.findlib) + List.map requires ~f:(Findlib.find_exn context.findlib + ~required_by:[Utils.jbuild_name_in ~dir:dir]) |> Findlib.closure in let includes = diff --git a/src/lib_db.ml b/src/lib_db.ml index 6f876dd0..6a71e8c0 100644 --- a/src/lib_db.ml +++ b/src/lib_db.ml @@ -32,7 +32,8 @@ let find_exn t ~from name = | None -> Hashtbl.find_or_add t.by_public_name name ~f:(fun name -> - External (Findlib.find_exn t.findlib name)) + External (Findlib.find_exn t.findlib name + ~required_by:[Utils.jbuild_name_in ~dir:from])) let find t ~from name = match find_exn t ~from name with diff --git a/src/utils.ml b/src/utils.ml index e61f2b18..d97c00c0 100644 --- a/src/utils.ml +++ b/src/utils.ml @@ -57,3 +57,12 @@ let signal_name = match List.assoc n table with | exception Not_found -> sprintf "%d\n" n | s -> s + +let jbuild_name_in ~dir = + match Path.extract_build_context dir with + | None -> + Path.to_string (Path.relative dir "jbuild") + | Some (ctx_name, dir) -> + sprintf "%s (context %s)" + (Path.to_string (Path.relative dir "jbuild")) + ctx_name diff --git a/src/utils.mli b/src/utils.mli index 15b1166d..5932f272 100644 --- a/src/utils.mli +++ b/src/utils.mli @@ -8,3 +8,6 @@ val system_shell : needed_to:string -> Path.t * string * fail option (** Convert a signal number to a name: INT, TERM, ... *) val signal_name : int -> string + +(** Return the path to the jbuild file in this directory as a string. *) +val jbuild_name_in : dir:Path.t -> string