Fix DB.all returning non unique libs (#565)
DB.all will return duplicate libraries in cases when it has 2 names for the same library. This fix changes all to return a set of values. This is to indicate and guarantee the uniqueness.
This commit is contained in:
parent
72af61f2a5
commit
7790d6bd4c
|
@ -45,9 +45,9 @@ module Gen(P : Install_params) = struct
|
||||||
|
|
||||||
let init_meta () =
|
let init_meta () =
|
||||||
let public_libs = Lib.DB.all (SC.public_libs sctx) in
|
let public_libs = Lib.DB.all (SC.public_libs sctx) in
|
||||||
List.iter public_libs ~f:gen_lib_dune_file;
|
Lib.Set.iter public_libs ~f:gen_lib_dune_file;
|
||||||
List.map public_libs ~f:(fun lib ->
|
Lib.Set.to_list public_libs
|
||||||
(Findlib.root_package_name (Lib.name lib), lib))
|
|> List.map ~f:(fun lib -> (Findlib.root_package_name (Lib.name lib), lib))
|
||||||
|> String_map.of_list_multi
|
|> String_map.of_list_multi
|
||||||
|> String_map.merge (SC.packages sctx) ~f:(fun _name pkg libs ->
|
|> String_map.merge (SC.packages sctx) ~f:(fun _name pkg libs ->
|
||||||
let pkg = Option.value_exn pkg in
|
let pkg = Option.value_exn pkg in
|
||||||
|
|
14
src/lib.ml
14
src/lib.ml
|
@ -319,6 +319,12 @@ let to_id t : Id.t =
|
||||||
; name = t.name
|
; name = t.name
|
||||||
}
|
}
|
||||||
|
|
||||||
|
module Set = Set.Make(
|
||||||
|
struct
|
||||||
|
type nonrec t = t
|
||||||
|
let compare x y = compare x.unique_id y.unique_id
|
||||||
|
end)
|
||||||
|
|
||||||
module L = struct
|
module L = struct
|
||||||
type nonrec t = t list
|
type nonrec t = t list
|
||||||
|
|
||||||
|
@ -973,13 +979,13 @@ module DB = struct
|
||||||
|
|
||||||
let rec all ?(recursive=false) t =
|
let rec all ?(recursive=false) t =
|
||||||
let l =
|
let l =
|
||||||
List.filter_map (Lazy.force t.all) ~f:(fun name ->
|
List.fold_left (Lazy.force t.all) ~f:(fun libs name ->
|
||||||
match find t name with
|
match find t name with
|
||||||
| Ok x -> Some x
|
| Ok x -> Set.add libs x
|
||||||
| Error _ -> None)
|
| Error _ -> libs) ~init:Set.empty
|
||||||
in
|
in
|
||||||
match recursive, t.parent with
|
match recursive, t.parent with
|
||||||
| true, Some t -> all ~recursive t @ l
|
| true, Some t -> Set.union (all ~recursive t) l
|
||||||
| _ -> l
|
| _ -> l
|
||||||
end
|
end
|
||||||
|
|
||||||
|
|
|
@ -30,6 +30,8 @@ val jsoo_runtime : t -> Path.t list
|
||||||
the process *)
|
the process *)
|
||||||
val unique_id : t -> int
|
val unique_id : t -> int
|
||||||
|
|
||||||
|
module Set : Set.S with type elt = t
|
||||||
|
|
||||||
module Status : sig
|
module Status : sig
|
||||||
type t =
|
type t =
|
||||||
| Installed
|
| Installed
|
||||||
|
@ -265,7 +267,7 @@ module DB : sig
|
||||||
(** Return the list of all libraries in this database. If
|
(** Return the list of all libraries in this database. If
|
||||||
[recursive] is true, also include libraries in parent databases
|
[recursive] is true, also include libraries in parent databases
|
||||||
recursively. *)
|
recursively. *)
|
||||||
val all : ?recursive:bool -> t -> lib list
|
val all : ?recursive:bool -> t -> Set.t
|
||||||
end with type lib := t
|
end with type lib := t
|
||||||
|
|
||||||
(** {1 Transitive closure} *)
|
(** {1 Transitive closure} *)
|
||||||
|
|
Loading…
Reference in New Issue