From 583255ca409893dbf6c8eddb9f8bd0b24fb2204f Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Javier=20Ch=C3=A1varri?= Date: Fri, 15 Mar 2024 12:07:50 +0000 Subject: [PATCH] attempt to fix mixed public/private cases MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Signed-off-by: Javier Chávarri --- src/dune_rules/lib.ml | 141 ++++++++---------- src/dune_rules/lib.mli | 5 +- src/dune_rules/scope.ml | 55 ++++--- .../eif-library-name-collision-same-folder.t | 14 ++ .../enabled_if/eif-library-name-collision.t | 17 +++ .../lib-collision-private-same-folder.t | 4 +- .../lib-collision/lib-collision-private.t | 12 +- 7 files changed, 141 insertions(+), 107 deletions(-) diff --git a/src/dune_rules/lib.ml b/src/dune_rules/lib.ml index 7d9829d688a..56c7431d6cc 100644 --- a/src/dune_rules/lib.ml +++ b/src/dune_rules/lib.ml @@ -418,11 +418,12 @@ type db = and resolve_result = | Not_found - | Found of Lib_info.external_ list + | Found of Lib_info.external_ | Hidden of Lib_info.external_ Hidden.t | Invalid of User_message.t | Ignore - | Redirect_in_the_same_db of (Loc.t * Lib_name.t) list + | Redirect_in_the_same_db of (Loc.t * Lib_name.t) + | Multiple_results of resolve_result list | Redirect of db * (Loc.t * Lib_name.t) | Deprecated_library_name of (Loc.t * Lib_name.t) @@ -1143,73 +1144,70 @@ end = struct | Hidden h -> Hidden.error h ~loc ~name >>| Option.some ;; - let find_in_parent ~db ~name = - let open Memo.O in - let+ res = - match db.parent with - | None -> Memo.return Status.Not_found - | Some db -> find_internal db name - in - res - ;; - - let to_status ~db ~name = function - | [] -> find_in_parent ~db ~name - | info :: [] -> instantiate db name info ~hidden:None - | a :: b :: _ -> - let loc = Lib_info.loc b in - let dir_a = Lib_info.src_dir a in - let dir_b = Lib_info.src_dir b in - Memo.return (Status.Invalid (Error.duplicated ~loc ~name ~dir_a ~dir_b)) - ;; - let resolve_name db name = let open Memo.O in db.resolve name >>= function | Ignore -> Memo.return Status.Ignore | Deprecated_library_name (_, name') -> find_internal db name' - | Redirect_in_the_same_db redirects -> - let result = List.map ~f:(fun (_, name') -> find_internal db name') redirects in - let* statuses = - Memo.List.map result ~f:(fun redirect -> - let* r = redirect in - Memo.return r) - in - Memo.return - (List.fold_left statuses ~init:Status.Not_found ~f:(fun acc status -> - match acc, status with - | Status.Found a, Status.Found b -> - let a = info a in - let b = info b in - let loc = Lib_info.loc b in - let dir_a = Lib_info.src_dir a in - let dir_b = Lib_info.src_dir b in - Status.Invalid (Error.duplicated ~loc ~name ~dir_a ~dir_b) - | Invalid _, _ -> acc - | (Found _ as lib), (Hidden _ | Ignore | Not_found | Invalid _) - | (Hidden _ | Ignore | Not_found), (Found _ as lib) -> lib - | (Hidden _ | Ignore | Not_found), (Hidden _ | Ignore | Not_found | Invalid _) - -> acc)) + | Redirect_in_the_same_db (_, name') -> find_internal db name' | Redirect (db', (_, name')) -> find_internal db' name' - | Found libs -> + | Found info -> instantiate db name info ~hidden:None + | Multiple_results libs -> + let* libs = + Memo.List.filter_map + ~f:(function + | Ignore -> Memo.return (Some Status.Ignore) + | Deprecated_library_name (_, name') -> + find_internal db name' >>| fun f -> Some f + | Redirect_in_the_same_db (_, name') -> + find_internal db name' >>| fun f -> Some f + | Redirect (db', (_, name')) -> find_internal db' name' >>| fun f -> Some f + | Found info -> + let* enabled = Lib_info.enabled info in + (match enabled with + | Disabled_because_of_enabled_if -> Memo.return None + | Normal | Optional -> + instantiate db name info ~hidden:None >>| fun f -> Some f) + | Multiple_results _libs -> + (* There can't be nested Multiple_results *) assert false + | Invalid e -> Memo.return (Some (Status.Invalid e)) + | Not_found -> + (match db.parent with + | None -> Memo.return (Some Status.Not_found) + | Some db -> find_internal db name >>| fun f -> Some f) + | Hidden { lib = info; reason = hidden; path = _ } -> + (match db.parent with + | None -> Memo.return Status.Not_found + | Some db -> find_internal db name) + >>= (function + | Status.Found _ as x -> Memo.return (Some x) + | _ -> instantiate db name info ~hidden:(Some hidden) >>| fun f -> Some f)) + libs + in (match libs with - | [] | _ :: [] -> + | [] -> assert false + | [ status ] -> (* In case we have 0 or 1 results found, convert to [Status.t] directly. This allows to provide better errors later on, e.g. `Library "foo" in _build/default is hidden (unsatisfied 'enabled_if') *) - to_status ~db ~name libs - | _ :: _ :: _ -> - (* If there are multiple results found, we optimistically pre-filter to - remove those that are disabled *) - let* filtered_libs = - Memo.List.filter libs ~f:(fun lib -> - let+ enabled = Lib_info.enabled lib in - match enabled with - | Disabled_because_of_enabled_if -> false - | Normal | Optional -> true) - in - to_status ~db ~name filtered_libs) + Memo.return status + | _ :: _ :: _ as statuses -> + Memo.return + (List.fold_left statuses ~init:Status.Not_found ~f:(fun acc status -> + match acc, status with + | Status.Found a, Status.Found b -> + let a = info a in + let b = info b in + let loc = Lib_info.loc b in + let dir_a = Lib_info.src_dir a in + let dir_b = Lib_info.src_dir b in + Status.Invalid (Error.duplicated ~loc ~name ~dir_a ~dir_b) + | Invalid _, _ -> acc + | (Found _ as lib), (Hidden _ | Ignore | Not_found | Invalid _) + | (Hidden _ | Ignore | Not_found), (Found _ as lib) -> lib + | ( (Hidden _ | Ignore | Not_found) + , (Hidden _ | Ignore | Not_found | Invalid _) ) -> acc))) | Invalid e -> Memo.return (Status.Invalid e) | Not_found -> (match db.parent with @@ -1844,35 +1842,28 @@ end module DB = struct module Resolve_result = struct - type t = resolve_result = - | Not_found - | Found of Lib_info.external_ list - | Hidden of Lib_info.external_ Hidden.t - | Invalid of User_message.t - | Ignore - | Redirect_in_the_same_db of (Loc.t * Lib_name.t) list - | Redirect of db * (Loc.t * Lib_name.t) - | Deprecated_library_name of (Loc.t * Lib_name.t) + type t = resolve_result let found f = Found f let not_found = Not_found let redirect db lib = Redirect (db, lib) - let redirect_in_the_same_db libs = Redirect_in_the_same_db libs + let redirect_in_the_same_db lib = Redirect_in_the_same_db lib + let multiple_results libs = Multiple_results libs let deprecated_library_name lib = Deprecated_library_name lib - let to_dyn x = + let rec to_dyn x = let open Dyn in match x with | Not_found -> variant "Not_found" [] | Invalid e -> variant "Invalid" [ Dyn.string (User_message.to_string e) ] - | Found libs -> variant "Found" [ (Dyn.list (Lib_info.to_dyn Path.to_dyn)) libs ] + | Found lib -> variant "Found" [ Lib_info.to_dyn Path.to_dyn lib ] | Hidden h -> variant "Hidden" [ Hidden.to_dyn (Lib_info.to_dyn Path.to_dyn) h ] | Ignore -> variant "Ignore" [] | Redirect (_, (_, name)) -> variant "Redirect" [ Lib_name.to_dyn name ] - | Redirect_in_the_same_db redirects -> - variant - "Redirect_in_the_same_db" - [ (Dyn.list (fun (_, name) -> Lib_name.to_dyn name)) redirects ] + | Redirect_in_the_same_db (_, name) -> + variant "Redirect_in_the_same_db" [ Lib_name.to_dyn name ] + | Multiple_results redirects -> + variant "Multiple_results" [ (Dyn.list to_dyn) redirects ] | Deprecated_library_name (_, name) -> variant "Deprecated_library_name" [ Lib_name.to_dyn name ] ;; @@ -1905,7 +1896,7 @@ module DB = struct let open Memo.O in Findlib.find findlib name >>| function - | Ok (Library pkg) -> Found [ Dune_package.Lib.info pkg ] + | Ok (Library pkg) -> Found (Dune_package.Lib.info pkg) | Ok (Deprecated_library_name d) -> Deprecated_library_name (d.loc, d.new_public_name) | Ok (Hidden_library pkg) -> Hidden (Hidden.unsatisfied_exist_if pkg) diff --git a/src/dune_rules/lib.mli b/src/dune_rules/lib.mli index 5320652a21a..20e0030ad0f 100644 --- a/src/dune_rules/lib.mli +++ b/src/dune_rules/lib.mli @@ -98,10 +98,11 @@ module DB : sig type t val not_found : t - val found : Lib_info.external_ list -> t + val found : Lib_info.external_ -> t val to_dyn : t Dyn.builder val redirect : db -> Loc.t * Lib_name.t -> t - val redirect_in_the_same_db : (Loc.t * Lib_name.t) list -> t + val redirect_in_the_same_db : Loc.t * Lib_name.t -> t + val multiple_results : t list -> t val deprecated_library_name : Loc.t * Lib_name.t -> t end diff --git a/src/dune_rules/scope.ml b/src/dune_rules/scope.ml index 8388a94605b..b9bb33d5844 100644 --- a/src/dune_rules/scope.ml +++ b/src/dune_rules/scope.ml @@ -25,27 +25,29 @@ module DB = struct module Found_or_redirect : sig type t = private - | Found of Lib_info.external_ list - | Redirect of (Loc.t * Lib_name.t) list + | Found of Lib_info.external_ + | Redirect of (Loc.t * Lib_name.t) + | Many of t list | Deprecated_library_name of (Loc.t * Lib_name.t) val redirect : Lib_name.t -> Loc.t * Lib_name.t -> Lib_name.t * t - val redirect_many : (Loc.t * Lib_name.t) list -> t + val many : t list -> t val deprecated_library_name : Lib_name.t -> Loc.t * Lib_name.t -> Lib_name.t * t - val found : Lib_info.external_ list -> t + val found : Lib_info.external_ -> t end = struct type t = - | Found of Lib_info.external_ list - | Redirect of (Loc.t * Lib_name.t) list + | Found of Lib_info.external_ + | Redirect of (Loc.t * Lib_name.t) + | Many of t list | Deprecated_library_name of (Loc.t * Lib_name.t) let redirect from (loc, to_) = if Lib_name.equal from to_ then Code_error.raise ~loc "Invalid redirect" [ "to_", Lib_name.to_dyn to_ ] - else from, Redirect [ loc, to_ ] + else from, Redirect (loc, to_) ;; - let redirect_many x = Redirect x + let many x = Many x let deprecated_library_name from (loc, to_) = if Lib_name.equal from to_ @@ -75,26 +77,22 @@ module DB = struct Found_or_redirect.deprecated_library_name old_public_name s.new_public_name | Library (dir, (conf : Library.t)) -> let info = Library.to_lib_info conf ~dir ~lib_config |> Lib_info.of_local in - Library.best_name conf, Found_or_redirect.found [ info ]) + Library.best_name conf, Found_or_redirect.found info) |> Lib_name.Map.of_list_reducei ~f:(fun name (v1 : Found_or_redirect.t) v2 -> let res = match v1, v2 with - | Found info1, Found info2 -> - Ok (Found_or_redirect.found (List.rev_append info1 info2)) - | Found info, Redirect redirect | Redirect redirect, Found info -> - let loc, _ = List.hd redirect in - Error (loc, Lib_info.loc (List.hd info)) + | Found _, Found _ + | Found _, Redirect _ + | Redirect _, Found _ + | Redirect _, Redirect _ -> Ok (Found_or_redirect.many [ v1; v2 ]) | Found info, Deprecated_library_name (loc, _) - | Deprecated_library_name (loc, _), Found info -> - Error (loc, Lib_info.loc (List.hd info)) - | Deprecated_library_name (loc2, lib2), Redirect redirect - | Redirect redirect, Deprecated_library_name (loc2, lib2) -> - let loc1, lib1 = List.hd redirect in + | Deprecated_library_name (loc, _), Found info -> Error (loc, Lib_info.loc info) + | Deprecated_library_name (loc2, lib2), Redirect (loc1, lib1) + | Redirect (loc1, lib1), Deprecated_library_name (loc2, lib2) -> if Lib_name.equal lib1 lib2 then Ok v1 else Error (loc1, loc2) - | Redirect redirect1, Redirect redirect2 -> - Ok (Found_or_redirect.redirect_many (List.rev_append redirect1 redirect2)) | Deprecated_library_name (loc1, lib1), Deprecated_library_name (loc2, lib2) -> if Lib_name.equal lib1 lib2 then Ok v1 else Error (loc1, loc2) + | Many _, _ | _, Many _ -> assert false in match res with | Ok x -> x @@ -126,6 +124,19 @@ module DB = struct (match Lib_name.Map.find map name with | None -> Lib.DB.Resolve_result.not_found | Some (Redirect lib) -> Lib.DB.Resolve_result.redirect_in_the_same_db lib + | Some (Many libs) -> + let results = + List.map + ~f:(function + | Found_or_redirect.Redirect lib -> + Lib.DB.Resolve_result.redirect_in_the_same_db lib + | Found lib -> Lib.DB.Resolve_result.found lib + | Deprecated_library_name lib -> + Lib.DB.Resolve_result.deprecated_library_name lib + | Many _ -> assert false) + libs + in + Lib.DB.Resolve_result.multiple_results results | Some (Deprecated_library_name lib) -> Lib.DB.Resolve_result.deprecated_library_name lib | Some (Found lib) -> Lib.DB.Resolve_result.found lib)) @@ -144,7 +155,7 @@ module DB = struct | Some (Project project) -> let scope = find_by_project (Fdecl.get t) project in Lib.DB.Resolve_result.redirect scope.db (Loc.none, name) - | Some (Name name) -> Lib.DB.Resolve_result.redirect_in_the_same_db [ name ] + | Some (Name name) -> Lib.DB.Resolve_result.redirect_in_the_same_db name ;; let public_theories ~find_db ~installed_theories coq_stanzas = diff --git a/test/blackbox-tests/test-cases/enabled_if/eif-library-name-collision-same-folder.t b/test/blackbox-tests/test-cases/enabled_if/eif-library-name-collision-same-folder.t index c7dd6150dc0..0756766f316 100644 --- a/test/blackbox-tests/test-cases/enabled_if/eif-library-name-collision-same-folder.t +++ b/test/blackbox-tests/test-cases/enabled_if/eif-library-name-collision-same-folder.t @@ -54,3 +54,17 @@ For public libraries > EOF $ dune build + +Mixing public and private libraries + + $ cat > dune << EOF + > (library + > (name foo) + > (enabled_if (= %{context_name} "default"))) + > (library + > (name foo) + > (public_name baz.foo) + > (enabled_if (= %{context_name} "alt-context"))) + > EOF + + $ dune build diff --git a/test/blackbox-tests/test-cases/enabled_if/eif-library-name-collision.t b/test/blackbox-tests/test-cases/enabled_if/eif-library-name-collision.t index f1a9f9492fb..1aa17eff19d 100644 --- a/test/blackbox-tests/test-cases/enabled_if/eif-library-name-collision.t +++ b/test/blackbox-tests/test-cases/enabled_if/eif-library-name-collision.t @@ -55,3 +55,20 @@ For public libraries > EOF $ dune build + +Mixing public and private libraries + + $ cat > a/dune << EOF + > (library + > (name foo) + > (enabled_if (= %{context_name} "default"))) + > EOF + + $ cat > b/dune << EOF + > (library + > (name foo) + > (public_name baz.foo) + > (enabled_if (= %{context_name} "alt-context"))) + > EOF + + $ dune build diff --git a/test/blackbox-tests/test-cases/lib-collision/lib-collision-private-same-folder.t b/test/blackbox-tests/test-cases/lib-collision/lib-collision-private-same-folder.t index ebd61016af6..023c2a622fc 100644 --- a/test/blackbox-tests/test-cases/lib-collision/lib-collision-private-same-folder.t +++ b/test/blackbox-tests/test-cases/lib-collision/lib-collision-private-same-folder.t @@ -16,7 +16,7 @@ Without any consumers of the libraries $ dune build Error: - File "dune", line 1, characters 0-21: + File "dune", line 3, characters 0-21: Error: A library with name "foo" is defined in two folders: _build/default and _build/default. Either change one of the names, or enable them conditionally using the 'enabled_if' field. @@ -41,7 +41,7 @@ With some consumer of the library $ dune build Error: - File "dune", line 1, characters 0-21: + File "dune", line 3, characters 0-21: Error: A library with name "foo" is defined in two folders: _build/default and _build/default. Either change one of the names, or enable them conditionally using the 'enabled_if' field. diff --git a/test/blackbox-tests/test-cases/lib-collision/lib-collision-private.t b/test/blackbox-tests/test-cases/lib-collision/lib-collision-private.t index 418d5587d34..bb154180d68 100644 --- a/test/blackbox-tests/test-cases/lib-collision/lib-collision-private.t +++ b/test/blackbox-tests/test-cases/lib-collision/lib-collision-private.t @@ -21,9 +21,9 @@ Without any consumers of the libraries $ dune build Error: - File "b/dune", line 1, characters 0-21: + File "a/dune", line 1, characters 0-21: Error: A library with name "foo" is defined in two folders: _build/default/a - and _build/default/b. Either change one of the names, or enable them + and _build/default/a. Either change one of the names, or enable them conditionally using the 'enabled_if' field. -> required by alias default @@ -43,16 +43,16 @@ With some consumer of the library $ dune build Error: - File "b/dune", line 1, characters 0-21: + File "a/dune", line 1, characters 0-21: Error: A library with name "foo" is defined in two folders: _build/default/a - and _build/default/b. Either change one of the names, or enable them + and _build/default/a. Either change one of the names, or enable them conditionally using the 'enabled_if' field. -> required by alias default - File "b/dune", line 1, characters 0-21: + File "a/dune", line 1, characters 0-21: 1 | (library 2 | (name foo)) Error: A library with name "foo" is defined in two folders: _build/default/a - and _build/default/b. Either change one of the names, or enable them + and _build/default/a. Either change one of the names, or enable them conditionally using the 'enabled_if' field. [1]