From 8c780999c393469c1c2a904bfb2d019d9507ceff Mon Sep 17 00:00:00 2001 From: Lucas Pluvinage Date: Fri, 1 Mar 2019 17:06:13 +0100 Subject: [PATCH] Variants - simplified (ocaml/dune#1859) The new algorithm takes place in closure computation. It builds a map from virtual libraries to implementations, and resolves default implementation selection. New tests have been added. Signed-off-by: Lucas Pluvinage --- src/dune_file.ml | 5 +- src/dune_file.mli | 2 +- src/dune_package.ml | 6 +- src/dune_package.mli | 4 +- src/lib.ml | 305 +++++++++++------- src/lib.mli | 17 +- src/lib_info.ml | 2 +- src/lib_info.mli | 2 +- src/scope.ml | 6 +- .../dependency-cycle/async.c/async.ml | 1 + .../variants/dependency-cycle/async.c/dune | 4 + .../dependency-cycle/async.ocaml/async.ml | 1 + .../dependency-cycle/async.ocaml/dune | 5 + .../variants/dependency-cycle/async/async.mli | 1 + .../variants/dependency-cycle/async/dune | 6 + .../variants/dependency-cycle/bar.ml | 1 + .../dependency-cycle/clock.c/clock.ml | 1 + .../variants/dependency-cycle/clock.c/dune | 5 + .../dependency-cycle/clock.ocaml/clock.ml | 1 + .../dependency-cycle/clock.ocaml/dune | 4 + .../variants/dependency-cycle/clock/clock.mli | 1 + .../variants/dependency-cycle/clock/dune | 6 + .../test-cases/variants/dependency-cycle/dune | 8 + .../variants/dependency-cycle/dune-project | 1 + .../dependency-cycle/test.default/dune | 5 + .../dependency-cycle/test.default/test.ml | 1 + .../variants/dependency-cycle/test/dune | 6 + .../variants/dependency-cycle/test/test.mli | 1 + .../variants/resolution-priority/bar.ml | 3 + .../resolution-priority/direct.c/direct.ml | 1 + .../resolution-priority/direct.c/dune | 4 + .../direct.default/direct.ml | 1 + .../resolution-priority/direct.default/dune | 5 + .../direct.ocaml/direct.ml | 1 + .../resolution-priority/direct.ocaml/dune | 5 + .../resolution-priority/direct/direct.mli | 1 + .../variants/resolution-priority/direct/dune | 6 + .../variants/resolution-priority/dune | 9 + .../variants/resolution-priority/dune-project | 1 + .../resolution-priority/test.default/dune | 5 + .../resolution-priority/test.default/test.ml | 1 + .../variants/resolution-priority/test/dune | 6 + .../resolution-priority/test/test.mli | 1 + .../resolution-priority/variant.c/dune | 5 + .../resolution-priority/variant.c/variant.ml | 1 + .../resolution-priority/variant.default/dune | 5 + .../variant.default/variant.ml | 1 + .../variants/resolution-priority/variant/dune | 6 + .../resolution-priority/variant/variant.mli | 1 + test/blackbox-tests/test-cases/variants/run.t | 26 ++ .../variants/variants-base/lib/dune | 2 +- 51 files changed, 371 insertions(+), 134 deletions(-) create mode 100644 test/blackbox-tests/test-cases/variants/dependency-cycle/async.c/async.ml create mode 100644 test/blackbox-tests/test-cases/variants/dependency-cycle/async.c/dune create mode 100644 test/blackbox-tests/test-cases/variants/dependency-cycle/async.ocaml/async.ml create mode 100644 test/blackbox-tests/test-cases/variants/dependency-cycle/async.ocaml/dune create mode 100644 test/blackbox-tests/test-cases/variants/dependency-cycle/async/async.mli create mode 100644 test/blackbox-tests/test-cases/variants/dependency-cycle/async/dune create mode 100644 test/blackbox-tests/test-cases/variants/dependency-cycle/bar.ml create mode 100644 test/blackbox-tests/test-cases/variants/dependency-cycle/clock.c/clock.ml create mode 100644 test/blackbox-tests/test-cases/variants/dependency-cycle/clock.c/dune create mode 100644 test/blackbox-tests/test-cases/variants/dependency-cycle/clock.ocaml/clock.ml create mode 100644 test/blackbox-tests/test-cases/variants/dependency-cycle/clock.ocaml/dune create mode 100644 test/blackbox-tests/test-cases/variants/dependency-cycle/clock/clock.mli create mode 100644 test/blackbox-tests/test-cases/variants/dependency-cycle/clock/dune create mode 100644 test/blackbox-tests/test-cases/variants/dependency-cycle/dune create mode 100644 test/blackbox-tests/test-cases/variants/dependency-cycle/dune-project create mode 100644 test/blackbox-tests/test-cases/variants/dependency-cycle/test.default/dune create mode 100644 test/blackbox-tests/test-cases/variants/dependency-cycle/test.default/test.ml create mode 100644 test/blackbox-tests/test-cases/variants/dependency-cycle/test/dune create mode 100644 test/blackbox-tests/test-cases/variants/dependency-cycle/test/test.mli create mode 100644 test/blackbox-tests/test-cases/variants/resolution-priority/bar.ml create mode 100644 test/blackbox-tests/test-cases/variants/resolution-priority/direct.c/direct.ml create mode 100644 test/blackbox-tests/test-cases/variants/resolution-priority/direct.c/dune create mode 100644 test/blackbox-tests/test-cases/variants/resolution-priority/direct.default/direct.ml create mode 100644 test/blackbox-tests/test-cases/variants/resolution-priority/direct.default/dune create mode 100644 test/blackbox-tests/test-cases/variants/resolution-priority/direct.ocaml/direct.ml create mode 100644 test/blackbox-tests/test-cases/variants/resolution-priority/direct.ocaml/dune create mode 100644 test/blackbox-tests/test-cases/variants/resolution-priority/direct/direct.mli create mode 100644 test/blackbox-tests/test-cases/variants/resolution-priority/direct/dune create mode 100644 test/blackbox-tests/test-cases/variants/resolution-priority/dune create mode 100644 test/blackbox-tests/test-cases/variants/resolution-priority/dune-project create mode 100644 test/blackbox-tests/test-cases/variants/resolution-priority/test.default/dune create mode 100644 test/blackbox-tests/test-cases/variants/resolution-priority/test.default/test.ml create mode 100644 test/blackbox-tests/test-cases/variants/resolution-priority/test/dune create mode 100644 test/blackbox-tests/test-cases/variants/resolution-priority/test/test.mli create mode 100644 test/blackbox-tests/test-cases/variants/resolution-priority/variant.c/dune create mode 100644 test/blackbox-tests/test-cases/variants/resolution-priority/variant.c/variant.ml create mode 100644 test/blackbox-tests/test-cases/variants/resolution-priority/variant.default/dune create mode 100644 test/blackbox-tests/test-cases/variants/resolution-priority/variant.default/variant.ml create mode 100644 test/blackbox-tests/test-cases/variants/resolution-priority/variant/dune create mode 100644 test/blackbox-tests/test-cases/variants/resolution-priority/variant/variant.mli diff --git a/src/dune_file.ml b/src/dune_file.ml index 4c6c0c181db..3f06ac01466 100644 --- a/src/dune_file.ml +++ b/src/dune_file.ml @@ -837,7 +837,7 @@ module Library = struct ; virtual_modules : Ordered_set_lang.t option ; implements : (Loc.t * Lib_name.t) option ; variant : Variant.t option - ; default_implementation : Lib_name.t option + ; default_implementation : (Loc.t * Lib_name.t) option ; private_modules : Ordered_set_lang.t option ; stdlib : Stdlib.t option } @@ -940,8 +940,7 @@ module Library = struct match implements, variant with | None, Some (loc, _) -> of_sexp_error loc "Only implementations can specify a variant." | _ -> (); - let default_implementation = Option.map default_implementation ~f:(fun (_, v) -> v) - and variant = Option.map variant ~f:(fun (_, v) -> v) in + let variant = Option.map variant ~f:(fun (_, v) -> v) in let self_build_stubs_archive = let loc, self_build_stubs_archive = self_build_stubs_archive in let err = diff --git a/src/dune_file.mli b/src/dune_file.mli index 3a0ea473afd..c42b9a2b48a 100644 --- a/src/dune_file.mli +++ b/src/dune_file.mli @@ -213,7 +213,7 @@ module Library : sig ; virtual_modules : Ordered_set_lang.t option ; implements : (Loc.t * Lib_name.t) option ; variant : Variant.t option - ; default_implementation : Lib_name.t option + ; default_implementation : (Loc.t * Lib_name.t) option ; private_modules : Ordered_set_lang.t option ; stdlib : Stdlib.t option } diff --git a/src/dune_package.ml b/src/dune_package.ml index 3ed4a62efad..7e4cb9a8734 100644 --- a/src/dune_package.ml +++ b/src/dune_package.ml @@ -21,7 +21,7 @@ module Lib = struct ; virtual_ : bool ; implements : (Loc.t * Lib_name.t) option ; variant : Variant.t option - ; default_implementation : Lib_name.t option + ; default_implementation : (Loc.t * Lib_name.t) option ; modules : Lib_modules.t option ; main_module_name : Module.Name.t option ; requires : (Loc.t * Lib_name.t) list @@ -99,7 +99,7 @@ module Lib = struct ; libs "ppx_runtime_deps" ppx_runtime_deps ; field_o "implements" (no_loc Lib_name.encode) implements ; field_o "variant" Variant.encode variant - ; field_o "default_implementation" Lib_name.encode default_implementation + ; field_o "default_implementation" (no_loc Lib_name.encode) default_implementation ; field_o "main_module_name" Module.Name.encode main_module_name ; field_l "modes" sexp (Mode.Dict.Set.encode modes) ; field_l "modules" sexp @@ -123,7 +123,7 @@ module Lib = struct field_o "main_module_name" Module.Name.decode >>= fun main_module_name -> field_o "implements" (located Lib_name.decode) >>= fun implements -> field_o "variant" Variant.decode >>= fun variant -> - field_o "default_implementation" Lib_name.decode >>= fun default_implementation -> + field_o "default_implementation" (located Lib_name.decode) >>= fun default_implementation -> field "name" Lib_name.decode >>= fun name -> let dir = Path.append_local base (dir_of_name name) in let%map synopsis = field_o "synopsis" string diff --git a/src/dune_package.mli b/src/dune_package.mli index 8f7265a33fb..e340aa78e90 100644 --- a/src/dune_package.mli +++ b/src/dune_package.mli @@ -23,7 +23,7 @@ module Lib : sig val jsoo_runtime : _ t -> Path.t list val implements : _ t -> (Loc.t * Lib_name.t) option val variant : _ t -> Variant.t option - val default_implementation : _ t -> Lib_name.t option + val default_implementation : _ t -> (Loc.t * Lib_name.t) option val dir_of_name : Lib_name.t -> Path.Local.t @@ -49,7 +49,7 @@ module Lib : sig -> ppx_runtime_deps:(Loc.t * Lib_name.t) list -> implements:(Loc.t * Lib_name.t) option -> variant: (Variant.t) option - -> default_implementation: (Lib_name.t) option + -> default_implementation: (Loc.t * Lib_name.t) option -> virtual_:bool -> modules:Lib_modules.t option -> modes:Mode.Dict.Set.t diff --git a/src/lib.ml b/src/lib.ml index 62496ba7401..e3edd4467fa 100644 --- a/src/lib.ml +++ b/src/lib.ml @@ -67,7 +67,7 @@ module Error = struct } end - module Multiple_solutions_for_implementation = struct + module Multiple_implementations_for_virtual_lib = struct type t = { lib : Lib_info.t ; given_variants : Variant.Set.t @@ -90,6 +90,13 @@ module Error = struct } end + module Default_implementation_cycle = struct + type t = + { + cycle : Lib_info.t list + } + end + type t = | Library_not_available of Library_not_available.t | No_solution_found_for_select of No_solution_found_for_select.t @@ -100,7 +107,8 @@ module Error = struct | Double_implementation of Double_implementation.t | No_implementation of No_implementation.t | Not_virtual_lib of Not_virtual_lib.t - | Multiple_solutions_for_implementation of Multiple_solutions_for_implementation.t + | Multiple_implementations_for_virtual_lib of Multiple_implementations_for_virtual_lib.t + | Default_implementation_cycle of Default_implementation_cycle.t end exception Error of Error.t @@ -191,7 +199,6 @@ type t = ; resolved_selects : Resolved_select.t list ; user_written_deps : Dune_file.Lib_deps.t ; implements : t Or_exn.t option - ; variant : Variant.t option ; (* This is mutable to avoid this error: {[ @@ -210,7 +217,7 @@ type status = type db = { parent : db option ; resolve : Lib_name.t -> resolve_result - ; find_implementations : Variant.t -> Lib_name.t -> Lib_info.t list + ; find_implementations : Lib_name.t -> Lib_info.t list Variant.Map.t ; table : (Lib_name.t, status) Hashtbl.t ; all : Lib_name.t list Lazy.t } @@ -654,6 +661,12 @@ end = struct Ok closure end + +type vlib_status = + | No_implementation + | Implemented_by of Lib_name.t + | Too_many_impl of Lib_name.t list + let rec instantiate db name (info : Lib_info.t) ~stack ~hidden = let id, stack = Dep_stack.create_and_push stack name info.src_dir @@ -677,10 +690,8 @@ let rec instantiate db name (info : Lib_info.t) ~stack ~hidden = Error (Error (Error.Not_virtual_lib { impl = info ; loc ; not_vlib = vlib.info }))) in - let variant = info.variant - in let requires, pps, resolved_selects = - resolve_user_deps db info.requires ~allow_private_deps ~pps:info.pps ~stack ~variants:Variant.Set.empty ~user_written_deps:Lib_name.Set.empty + resolve_user_deps db info.requires ~allow_private_deps ~pps:info.pps ~stack in let requires = match implements with @@ -710,7 +721,6 @@ let rec instantiate db name (info : Lib_info.t) ~stack ~hidden = ; user_written_deps = Lib_info.user_written_deps info ; sub_systems = Sub_system_name.Map.empty ; implements - ; variant } in t.sub_systems <- @@ -853,49 +863,8 @@ and resolve_complex_deps db deps ~allow_private_deps ~stack = in (res, resolved_selects) -and info_of_name db name = - match db.resolve name, db.parent with - | Redirect (db', name'), _ -> - let db' = Option.value db' ~default:db in - info_of_name db' name' - | Found info, _ -> Some info - | Not_found, None -> None - | Not_found, Some parent -> info_of_name parent name - | Hidden _, _ -> None - - -(* Try to find an implementation for virtual library. *) -and resolve_virtual_dep db (virt : Lib_info.t) ~allow_private_deps ~stack ~variants ~user_written_deps = - let rec explore_dbs db variants = - let implementations = - variants - |> Variant.Set.fold ~init:[] ~f:(fun v acc -> db.find_implementations v virt.name @ acc) - in - let has_concrete_implementation = - implementations - |> List.exists ~f:(fun (lib : Lib_info.t) -> Lib_name.Set.mem user_written_deps lib.name) - in - match has_concrete_implementation, implementations, db.parent with - | true, _, _ -> None - | false, [], Some parent_db -> explore_dbs parent_db variants - | _ -> Some implementations - in - let options = match explore_dbs db variants, virt.default_implementation with - | None, _ -> [] - | Some [], None -> [] - | Some [], Some v -> (match info_of_name db v with - | Some x -> [x] (*Fallback to default implementation.*) - | _ -> failwith "default implementation not found." ) - | Some lst, _ -> lst - in match options with - | [] -> Ok [], [] - | [lib] -> resolve_deps db (Lib_info.Deps.Simple [(virt.loc, lib.name)]) ~allow_private_deps ~stack ~variants ~user_written_deps - | multilib -> - let e = Error.Multiple_solutions_for_implementation {lib=virt; given_variants=variants; conflict=multilib} - in (Error (Error e)), [] - - -and resolve_deps db deps ~allow_private_deps ~stack ~variants ~user_written_deps = + +and resolve_deps db deps ~allow_private_deps ~stack = (* Compute transitive closure *) let libs, selects = match (deps : Lib_info.Deps.t) with | Simple names -> @@ -904,33 +873,12 @@ and resolve_deps db deps ~allow_private_deps ~stack ~variants ~user_written_deps resolve_complex_deps db names ~allow_private_deps ~stack in (* Find implementations for virtual libraries. *) - match libs with - | Error _ -> libs, selects - | Ok result -> - begin - let libs_selects_impl = (List.map ~f:(fun lib -> - match lib.info.virtual_ with - | None -> Ok [], [] - | Some _ -> resolve_virtual_dep db lib.info ~allow_private_deps ~stack ~variants ~user_written_deps) result - ) - in - let selects_deps, impl_deps = List.split libs_selects_impl in - let impl_deps = List.flatten impl_deps @ selects in - let concat_two_results a b = match a,b with - | Ok a, Ok b -> Ok (a@b) - | Ok _, Error b -> Error b - | Error a, Ok _ -> Error a - | Error _, Error b -> Error b - in - let select_deps = List.fold_left ~f:(fun a b -> concat_two_results a b) ~init:(Ok result) selects_deps in - select_deps, impl_deps - end + libs, selects - -and resolve_user_deps db deps ~allow_private_deps ~pps ~stack ~variants ~user_written_deps = +and resolve_user_deps db deps ~allow_private_deps ~pps ~stack = let deps, resolved_selects = - resolve_deps db deps ~allow_private_deps ~stack ~variants ~user_written_deps in + resolve_deps db deps ~allow_private_deps ~stack in let deps, pps = match pps with | [] -> (deps, Ok []) @@ -943,7 +891,7 @@ and resolve_user_deps db deps ~allow_private_deps ~pps ~stack ~variants ~user_wr let pps = resolve_simple_deps db pps ~allow_private_deps:true ~stack >>= fun pps -> - closure_with_overlap_checks None pps ~stack ~linking:true + closure_with_overlap_checks None pps ~stack ~linking:true ~variants:Variant.Set.empty in let deps = deps >>= fun init -> @@ -958,8 +906,119 @@ and resolve_user_deps db deps ~allow_private_deps ~pps ~stack ~variants ~user_wr in (deps, pps, resolved_selects) -and closure_with_overlap_checks db ts ~stack:orig_stack ~linking = +(* Update the variant status map according to `lib` which is being added to the closure. *) +and handle_vlibs lib virtual_status = match lib.info.virtual_, lib.info.implements with + | None, None -> Ok () + | Some _, None -> (* Virtual library: add it in the map if it doesn't exist yet. *) + begin + match Lib_name.Map.find !virtual_status lib.name with + | None -> virtual_status := Lib_name.Map.add !virtual_status lib.name No_implementation; Ok () + | Some _ -> Ok () + end + | None, Some (_, implements) -> (* Implementation: find the corresponding virtual library *) + (match Lib_name.Map.find !virtual_status implements with + | Some No_implementation | None -> (Ok (Implemented_by lib.name)) + | Some (Implemented_by x) -> Ok (Too_many_impl [lib.name; x]) + | Some (Too_many_impl lst) -> Ok (Too_many_impl (lib.name::lst))) >>= fun impl -> + virtual_status := Lib_name.Map.add !virtual_status implements impl; Ok () + | Some _, Some _ -> assert false + +(* Find implementation that matches given variants *) +and find_implementation_for db lib ~variants = + let available_implementations = db.find_implementations lib.name + in variants + |> Variant.Set.fold + ~init:[] + ~f:(fun variant lst -> + Variant.Map.find available_implementations variant + |> Option.value ~default:[] + |> fun x -> x @ lst ) + |> function + | [] -> Ok None + | [elem] -> Ok (Some elem) + | lst -> Error (Error (Multiple_implementations_for_virtual_lib {lib=lib.info; given_variants=variants; conflict=lst})) + +(* Compute transitive closure of libraries to figure which ones will trigger their default implementation. *) +(* Assertion: libraries is a list of virtual libraries with no implementation. *) +(* The goal is to find which libraries can safely be defaulted. *) +and resolve_default_libraries db libraries ~variants = + let vlib_dfs_status = ref Lib_name.Map.empty in (* Map from a vlib to vlibs that are implemented in the transitive closure of its default impl. *) + let vlib_default_parent = ref Lib_name.Map.empty in (* Reverse map *) + let merge lib = function + | Some x -> Some (lib::x) + | None -> Some [lib] + and avoid_direct_parent vlib (impl : lib) = + match impl.implements with + | None -> Ok true + | Some x -> x >>= fun x -> Ok (x.name <> vlib.name) + (* Either by variants or by default. *) + and get_default_implementation virtual_library = + find_implementation_for db virtual_library ~variants + >>= function + | Some x -> Ok (Some (x.loc, x.name)) + | None -> Ok virtual_library.info.default_implementation + in + let impl_different_from_vlib_default vlib (impl : lib) = + get_default_implementation vlib >>= function + | None -> Ok true + | Some (_,x) -> Ok (x <> impl.name) + and name_to_lib name loc = resolve_dep db name ~allow_private_deps:true ~loc ~stack:Dep_stack.empty + in + let library_is_default lib = match Lib_name.Map.find !vlib_default_parent lib.name with + | None | Some [] -> Option.bind lib.info.default_implementation ~f:(fun (loc,name) -> match name_to_lib name loc with | Error _ -> None | Ok lib -> Some lib ) + | Some _ -> None + in + (* Gather vlibs that are transitively implemented by another vlib's default implementation. *) + let rec visit ~stack ancestor_vlib = function + | [] -> Ok () + | lib::next -> + begin + match Lib_name.Map.find !vlib_dfs_status lib.name with + | Some (Some ()) -> Error (Error (Default_implementation_cycle {cycle=(lib.info::stack)})) + | Some (None) -> Ok () + | None -> + begin + (* Exploring node. *) + vlib_dfs_status := Lib_name.Map.add !vlib_dfs_status lib.name (Some ()); + (* Visit direct dependencies *) + lib.requires >>= fun deps -> + (List.filter ~f:(fun x -> match avoid_direct_parent x lib with | Ok x -> x | Error _ -> false) deps) + |> visit ~stack:(lib.info::stack) ancestor_vlib >>= fun () -> + (* If the library is an implementation of some virtual library that overrides default, add a link in the graph. *) + Option.map lib.implements + ~f:(fun vlib -> (vlib >>= fun vlib -> + begin + impl_different_from_vlib_default vlib lib >>= function res -> + match (res, ancestor_vlib) with + | true, None -> + visit ~stack:(lib.info::stack) None [vlib] (* Recursion: no ancestor, vlib is explored *) + | true, Some ancestor -> + vlib_default_parent := Lib_name.Map.update !vlib_default_parent lib.name ~f:(merge ancestor.name); + visit ~stack:(lib.info::stack) None [vlib] + | false, _ -> Ok () (* If lib is the default implementation, we'll manage it when handling virtual lib. *) + end)) + |> Option.value ~default:(Ok ()) >>= fun () -> + (* If the library has an implementation according to variants. *) + get_default_implementation lib >>= fun default_implementation -> + Option.map default_implementation ~f:(fun (loc,name) -> + name_to_lib name loc >>= fun default_impl -> + visit ~stack:(lib.info::stack) (Some lib) [default_impl]) + |> Option.value ~default:(Ok ()) >>= fun () -> + (* If the library is a virtual library with a default implementation. *) + vlib_dfs_status := Lib_name.Map.add !vlib_dfs_status lib.name None; + visit ~stack ancestor_vlib next + end + end + in + (* For each virtual library we know which vlibs will be implemented when enabling its default implementation. *) + visit ~stack:[] None libraries >>= fun () -> + Ok (List.filter_map ~f:library_is_default libraries) + + +and closure_with_overlap_checks db ts ~stack:orig_stack ~linking ~variants = + let name_to_lib name loc = resolve_dep (Option.value_exn db) name ~allow_private_deps:true ~loc ~stack:Dep_stack.empty in let visited = ref Lib_name.Map.empty in + let virtual_status = ref Lib_name.Map.empty in let res = ref [] in let rec loop t ~stack = match Lib_name.Map.find !visited t.name with @@ -992,17 +1051,46 @@ and closure_with_overlap_checks db ts ~stack:orig_stack ~linking = | _ -> assert false) >>= fun () -> Dep_stack.push stack (to_id t) >>= fun new_stack -> - t.requires >>= fun deps -> + t.requires >>= + fun deps -> + handle_vlibs t virtual_status >>= fun () -> Result.List.iter deps ~f:(loop ~stack:new_stack) >>| fun () -> res := (t, stack) :: !res in - Result.List.iter ts ~f:(loop ~stack:orig_stack) >>= fun () -> + (* Closure loop with virtual libraries/variants selection*) + let rec handle ts ~stack = + Result.List.iter ts ~f:(loop ~stack) >>= fun () -> + match linking with + | true -> begin + (* Virtual libraries: find implementations according to variants. *) + Lib_name.Map.foldi !virtual_status ~init:(Ok ([], [])) ~f:(fun name status acc -> match status with + | No_implementation -> acc >>= fun (lst,def) -> + begin + Lib_name.Map.find_exn !visited name |> fun (lib, _) -> + find_implementation_for (Option.value_exn db) lib ~variants + >>= fun impl -> match impl, lib.info.default_implementation with + | None, Some _ -> Ok (lst, (lib::def)) + | None, None -> Ok (lst, def) + | Some (impl_info : Lib_info.t), _ -> name_to_lib impl_info.name impl_info.loc >>= fun impl -> Ok (impl::lst, def) + end + | _ -> acc + ) + (* Manage unimplemented libraries that have a default implementation. *) + >>= fun (lst, with_default_impl) -> + match lst, with_default_impl with + | [], [] -> Ok () + | [], def -> resolve_default_libraries (Option.value_exn db) def ~variants >>= handle ~stack + | lst, _ -> handle lst ~stack + end + | false -> Ok () + in + handle ts ~stack:orig_stack >>= fun () -> Virtual_libs.associate (List.rev !res) ~linking ~orig_stack -let closure_with_overlap_checks db l = - closure_with_overlap_checks db l ~stack:Dep_stack.empty +let closure_with_overlap_checks db l ~variants = + closure_with_overlap_checks db l ~stack:Dep_stack.empty ~variants -let closure l = closure_with_overlap_checks None l +let closure l = closure_with_overlap_checks None l ~variants:Variant.Set.empty let to_exn res = match res with @@ -1039,7 +1127,7 @@ module Compile = struct ~kind:(Lib_deps_info.Kind.of_optional t.info.optional) in let requires_link = lazy ( - t.requires >>= closure_with_overlap_checks db ~linking:false + t.requires >>= closure_with_overlap_checks db ~linking:false ~variants:Variant.Set.empty ) in { direct_requires = t.requires ; requires_link @@ -1083,10 +1171,10 @@ module DB = struct let create_variant_map lib_info_list = List.concat_map lib_info_list ~f:(fun (info : Lib_info.t) -> match info.implements, info.variant with - | Some (_, virtual_lib), Some variant -> [(variant, (virtual_lib, [info]))] + | Some (_, virtual_lib), Some variant -> [(virtual_lib, (variant, [info]))] | _, _ -> []) - |> List.map ~f:(fun (variant, content) -> (variant, Lib_name.Map.of_list_exn [content])) - |> Variant.Map.of_list_reduce ~f:(fun s1 s2 -> Lib_name.Map.union s1 s2 ~f:(fun _ a b -> Some (a@b))) + |> List.map ~f:(fun (virtual_lib, content) -> (virtual_lib, Variant.Map.of_list_exn [content])) + |> Lib_name.Map.of_list_reduce ~f:(fun s1 s2 -> Variant.Map.union s1 s2 ~f:(fun _ a b -> Some (a@b))) let create_from_library_stanzas ?parent ~has_native ~ext_lib ~ext_obj @@ -1137,13 +1225,10 @@ module DB = struct match Lib_name.Map.find map name with | None -> Not_found | Some x -> x) - ~find_implementations:(fun variant virt -> - match Variant.Map.find variant_map variant with - | None -> [] - | Some x -> - match Lib_name.Map.find x virt with - | None -> [] - | Some lst -> lst + ~find_implementations:(fun virt -> + match Lib_name.Map.find variant_map virt with + | Some x -> x + | None -> Variant.Map.empty ) ~all:(fun () -> Lib_name.Map.keys map) @@ -1167,13 +1252,10 @@ module DB = struct Not_found | Hidden pkg -> Hidden (Lib_info.of_dune_lib pkg, "unsatisfied 'exist_if'")) - ~find_implementations:(fun variant virt -> - match Variant.Map.find variant_map variant with - | None -> [] - | Some x -> - match Lib_name.Map.find x virt with - | None -> [] - | Some lst -> lst + ~find_implementations:(fun virt -> + match Lib_name.Map.find variant_map virt with + | Some x -> x + | None -> Variant.Map.empty ) ~all:(fun () -> Findlib.all_packages findlib @@ -1216,23 +1298,16 @@ module DB = struct ~pps ~kind:Required in - let user_written_deps = - Lib_info.Deps.of_lib_deps deps - |> (function - | Simple deps -> List.map ~f:(fun (_,a) -> a) deps - | Complex deps -> List.map ~f:(fun dune_file -> Dune_file.Lib_dep.to_lib_names dune_file) deps |> List.flatten) (* This is wrong, should do select resolution.. *) - |> Lib_name.Set.of_list - in let res, pps, resolved_selects = resolve_user_deps t (Lib_info.Deps.of_lib_deps deps) ~pps ~stack:Dep_stack.empty ~allow_private_deps:true - ~variants ~user_written_deps in let requires_link = lazy ( res >>= closure_with_overlap_checks (Option.some_if (not allow_overlaps) t) ~linking:true + ~variants |> Result.map_error ~f:(fun e -> Dep_path.prepend_exn e (Executables exes)) ) in @@ -1302,10 +1377,19 @@ let report_lib_error ppf (e : Error.t) = Format.fprintf ppf "%a%a" lib info dep_path dp in match e with - | Multiple_solutions_for_implementation {lib; given_variants; conflict} -> + | Default_implementation_cycle {cycle} -> + Format.fprintf ppf + "@{Error@}: Default implementation cycle detected between the \ + following libraries:@\n\ + @[%a@]@\n" + (Format.pp_print_list (fun ppf (info : Lib_info.t) -> + Format.fprintf ppf "-> %a" + Lib_name.pp_quoted info.name)) + cycle + | Multiple_implementations_for_virtual_lib {lib; given_variants; conflict} -> let print_default_implementation ppf () = match lib.default_implementation with | None -> Format.fprintf ppf "" - | Some x -> Format.fprintf ppf "(default implementation %a)" Lib_name.pp x + | Some (_,x) -> Format.fprintf ppf "(default implementation %a)" Lib_name.pp x in let print_variants ppf () = match Variant.Set.is_empty given_variants with | true -> Format.fprintf ppf "" @@ -1386,7 +1470,6 @@ let report_lib_error ppf (e : Error.t) = Errors.print loc Lib_name.pp_quoted not_vlib.name Lib_name.pp_quoted impl.name - let () = Printexc.register_printer (function diff --git a/src/lib.mli b/src/lib.mli index d992bb4e278..2634f8d027b 100644 --- a/src/lib.mli +++ b/src/lib.mli @@ -128,7 +128,7 @@ module Error : sig type t end - module Multiple_solutions_for_implementation : sig + module Multiple_implementations_for_virtual_lib : sig type t end @@ -148,6 +148,10 @@ module Error : sig type t end + module Default_implementation_cycle : sig + type t + end + type t = | Library_not_available of Library_not_available.t | No_solution_found_for_select of No_solution_found_for_select.t @@ -158,7 +162,8 @@ module Error : sig | Double_implementation of Double_implementation.t | No_implementation of No_implementation.t | Not_virtual_lib of Not_virtual_lib.t - | Multiple_solutions_for_implementation of Multiple_solutions_for_implementation.t + | Multiple_implementations_for_virtual_lib of Multiple_implementations_for_virtual_lib.t + | Default_implementation_cycle of Default_implementation_cycle.t end exception Error of Error.t @@ -232,15 +237,11 @@ module DB : sig val create : ?parent:t -> resolve:(Lib_name.t -> Resolve_result.t) - -> find_implementations:(Variant.t -> Lib_name.t -> Lib_info.t list) + -> find_implementations:(Lib_name.t -> Lib_info.t list Variant.Map.t) -> all:(unit -> Lib_name.t list) -> unit -> t - val create_variant_map - : Lib_info.t list - -> Lib_info.t list Lib_name.Map.t Variant.Map.t - (** Create a database from a list of library stanzas *) val create_from_library_stanzas : ?parent:t @@ -270,7 +271,7 @@ module DB : sig for libraries that are optional and not available as well. *) val get_compile_info : t -> ?allow_overlaps:bool -> Lib_name.t -> Compile.t - val find_implementations : t -> Variant.t -> Lib_name.t -> Lib_info.t list + val find_implementations : t -> Lib_name.t -> Lib_info.t list Variant.Map.t val resolve : t -> Loc.t * Lib_name.t -> lib Or_exn.t diff --git a/src/lib_info.ml b/src/lib_info.ml index f40644a0f5b..df3dd1b9e83 100644 --- a/src/lib_info.ml +++ b/src/lib_info.ml @@ -73,7 +73,7 @@ type t = ; virtual_ : Lib_modules.t Source.t option ; implements : (Loc.t * Lib_name.t) option ; variant : Variant.t option - ; default_implementation : Lib_name.t option + ; default_implementation : (Loc.t * Lib_name.t) option ; wrapped : Wrapped.t Dune_file.Library.Inherited.t option ; main_module_name : Dune_file.Library.Main_module_name.t ; modes : Mode.Dict.Set.t diff --git a/src/lib_info.mli b/src/lib_info.mli index a31d3a519a7..4cdf68dcb85 100644 --- a/src/lib_info.mli +++ b/src/lib_info.mli @@ -54,7 +54,7 @@ type t = private ; virtual_ : Lib_modules.t Source.t option ; implements : (Loc.t * Lib_name.t) option ; variant : Variant.t option - ; default_implementation : Lib_name.t option + ; default_implementation : (Loc.t * Lib_name.t) option ; wrapped : Wrapped.t Dune_file.Library.Inherited.t option ; main_module_name : Dune_file.Library.Main_module_name.t ; modes : Mode.Dict.Set.t diff --git a/src/scope.ml b/src/scope.ml index 95f18d11adb..54fc8f3905d 100644 --- a/src/scope.ml +++ b/src/scope.ml @@ -114,15 +114,15 @@ module DB = struct Dune_project.Name.Map.find_exn !by_name_cell (Dune_project.name project) in Redirect (Some scope.db, name)) - ~find_implementations:(fun variant virt -> + ~find_implementations:(fun virt -> Lib_name.Map.values public_libs |> List.map ~f:(fun project -> let scope = Dune_project.Name.Map.find_exn !by_name_cell (Dune_project.name project) in - Lib.DB.find_implementations scope.db variant virt) - |> List.flatten + Lib.DB.find_implementations scope.db virt) + |> List.fold_left ~init:Variant.Map.empty ~f:(fun acc impls -> Variant.Map.union acc impls ~f:(fun _ a b -> Some (a@b))) ) ~all:(fun () -> Lib_name.Map.keys public_libs) in diff --git a/test/blackbox-tests/test-cases/variants/dependency-cycle/async.c/async.ml b/test/blackbox-tests/test-cases/variants/dependency-cycle/async.c/async.ml new file mode 100644 index 00000000000..00b119e3444 --- /dev/null +++ b/test/blackbox-tests/test-cases/variants/dependency-cycle/async.c/async.ml @@ -0,0 +1 @@ +let run () = Printf.printf "hi from async.c" \ No newline at end of file diff --git a/test/blackbox-tests/test-cases/variants/dependency-cycle/async.c/dune b/test/blackbox-tests/test-cases/variants/dependency-cycle/async.c/dune new file mode 100644 index 00000000000..38d53a0e54b --- /dev/null +++ b/test/blackbox-tests/test-cases/variants/dependency-cycle/async.c/dune @@ -0,0 +1,4 @@ +(library + (name async_c) + (implements async) + (variant c)) \ No newline at end of file diff --git a/test/blackbox-tests/test-cases/variants/dependency-cycle/async.ocaml/async.ml b/test/blackbox-tests/test-cases/variants/dependency-cycle/async.ocaml/async.ml new file mode 100644 index 00000000000..71f1a75796a --- /dev/null +++ b/test/blackbox-tests/test-cases/variants/dependency-cycle/async.ocaml/async.ml @@ -0,0 +1 @@ +let run () = Printf.printf "hi from async.ocaml" \ No newline at end of file diff --git a/test/blackbox-tests/test-cases/variants/dependency-cycle/async.ocaml/dune b/test/blackbox-tests/test-cases/variants/dependency-cycle/async.ocaml/dune new file mode 100644 index 00000000000..41845503932 --- /dev/null +++ b/test/blackbox-tests/test-cases/variants/dependency-cycle/async.ocaml/dune @@ -0,0 +1,5 @@ +(library + (name async_ocaml) + (implements async) + (libraries clock_ocaml) + (variant ocaml)) diff --git a/test/blackbox-tests/test-cases/variants/dependency-cycle/async/async.mli b/test/blackbox-tests/test-cases/variants/dependency-cycle/async/async.mli new file mode 100644 index 00000000000..6879ed37434 --- /dev/null +++ b/test/blackbox-tests/test-cases/variants/dependency-cycle/async/async.mli @@ -0,0 +1 @@ +val run : unit -> unit \ No newline at end of file diff --git a/test/blackbox-tests/test-cases/variants/dependency-cycle/async/dune b/test/blackbox-tests/test-cases/variants/dependency-cycle/async/dune new file mode 100644 index 00000000000..6819ef74b6b --- /dev/null +++ b/test/blackbox-tests/test-cases/variants/dependency-cycle/async/dune @@ -0,0 +1,6 @@ +(library + (name async) + (virtual_modules async) + (wrapped false) + (default_implementation async_ocaml) +) diff --git a/test/blackbox-tests/test-cases/variants/dependency-cycle/bar.ml b/test/blackbox-tests/test-cases/variants/dependency-cycle/bar.ml new file mode 100644 index 00000000000..20c9895f53b --- /dev/null +++ b/test/blackbox-tests/test-cases/variants/dependency-cycle/bar.ml @@ -0,0 +1 @@ +Clock.run ();; diff --git a/test/blackbox-tests/test-cases/variants/dependency-cycle/clock.c/clock.ml b/test/blackbox-tests/test-cases/variants/dependency-cycle/clock.c/clock.ml new file mode 100644 index 00000000000..60ee1e26098 --- /dev/null +++ b/test/blackbox-tests/test-cases/variants/dependency-cycle/clock.c/clock.ml @@ -0,0 +1 @@ +let run () = Printf.printf "hi from clock.c" \ No newline at end of file diff --git a/test/blackbox-tests/test-cases/variants/dependency-cycle/clock.c/dune b/test/blackbox-tests/test-cases/variants/dependency-cycle/clock.c/dune new file mode 100644 index 00000000000..b4c4a894a0c --- /dev/null +++ b/test/blackbox-tests/test-cases/variants/dependency-cycle/clock.c/dune @@ -0,0 +1,5 @@ +(library + (name clock_c) + (implements clock) + (libraries async_c) + (variant c)) diff --git a/test/blackbox-tests/test-cases/variants/dependency-cycle/clock.ocaml/clock.ml b/test/blackbox-tests/test-cases/variants/dependency-cycle/clock.ocaml/clock.ml new file mode 100644 index 00000000000..b4a105f9bc7 --- /dev/null +++ b/test/blackbox-tests/test-cases/variants/dependency-cycle/clock.ocaml/clock.ml @@ -0,0 +1 @@ +let run () = Printf.printf "hi from clock.ocaml" \ No newline at end of file diff --git a/test/blackbox-tests/test-cases/variants/dependency-cycle/clock.ocaml/dune b/test/blackbox-tests/test-cases/variants/dependency-cycle/clock.ocaml/dune new file mode 100644 index 00000000000..91c1cc3edf5 --- /dev/null +++ b/test/blackbox-tests/test-cases/variants/dependency-cycle/clock.ocaml/dune @@ -0,0 +1,4 @@ +(library + (name clock_ocaml) + (implements clock) + (variant ocaml)) \ No newline at end of file diff --git a/test/blackbox-tests/test-cases/variants/dependency-cycle/clock/clock.mli b/test/blackbox-tests/test-cases/variants/dependency-cycle/clock/clock.mli new file mode 100644 index 00000000000..6879ed37434 --- /dev/null +++ b/test/blackbox-tests/test-cases/variants/dependency-cycle/clock/clock.mli @@ -0,0 +1 @@ +val run : unit -> unit \ No newline at end of file diff --git a/test/blackbox-tests/test-cases/variants/dependency-cycle/clock/dune b/test/blackbox-tests/test-cases/variants/dependency-cycle/clock/dune new file mode 100644 index 00000000000..a4c241d3a1f --- /dev/null +++ b/test/blackbox-tests/test-cases/variants/dependency-cycle/clock/dune @@ -0,0 +1,6 @@ +(library + (name clock) + (virtual_modules clock) + (wrapped false) + (default_implementation clock_c) +) diff --git a/test/blackbox-tests/test-cases/variants/dependency-cycle/dune b/test/blackbox-tests/test-cases/variants/dependency-cycle/dune new file mode 100644 index 00000000000..aa816cc020c --- /dev/null +++ b/test/blackbox-tests/test-cases/variants/dependency-cycle/dune @@ -0,0 +1,8 @@ +(executable + (name bar) + (libraries async_ocaml clock_c test) +) + +(alias + (name default) + (action (run ./bar.exe))) diff --git a/test/blackbox-tests/test-cases/variants/dependency-cycle/dune-project b/test/blackbox-tests/test-cases/variants/dependency-cycle/dune-project new file mode 100644 index 00000000000..fd5c747c687 --- /dev/null +++ b/test/blackbox-tests/test-cases/variants/dependency-cycle/dune-project @@ -0,0 +1 @@ +(lang dune 1.7) \ No newline at end of file diff --git a/test/blackbox-tests/test-cases/variants/dependency-cycle/test.default/dune b/test/blackbox-tests/test-cases/variants/dependency-cycle/test.default/dune new file mode 100644 index 00000000000..9e7f0e4c657 --- /dev/null +++ b/test/blackbox-tests/test-cases/variants/dependency-cycle/test.default/dune @@ -0,0 +1,5 @@ +(library + (name test_default) + (implements test) + (libraries clock) + (variant default)) \ No newline at end of file diff --git a/test/blackbox-tests/test-cases/variants/dependency-cycle/test.default/test.ml b/test/blackbox-tests/test-cases/variants/dependency-cycle/test.default/test.ml new file mode 100644 index 00000000000..b4a105f9bc7 --- /dev/null +++ b/test/blackbox-tests/test-cases/variants/dependency-cycle/test.default/test.ml @@ -0,0 +1 @@ +let run () = Printf.printf "hi from clock.ocaml" \ No newline at end of file diff --git a/test/blackbox-tests/test-cases/variants/dependency-cycle/test/dune b/test/blackbox-tests/test-cases/variants/dependency-cycle/test/dune new file mode 100644 index 00000000000..e9ea057e7d1 --- /dev/null +++ b/test/blackbox-tests/test-cases/variants/dependency-cycle/test/dune @@ -0,0 +1,6 @@ +(library + (name test) + (virtual_modules test) + (wrapped false) + (default_implementation test_default) +) diff --git a/test/blackbox-tests/test-cases/variants/dependency-cycle/test/test.mli b/test/blackbox-tests/test-cases/variants/dependency-cycle/test/test.mli new file mode 100644 index 00000000000..6879ed37434 --- /dev/null +++ b/test/blackbox-tests/test-cases/variants/dependency-cycle/test/test.mli @@ -0,0 +1 @@ +val run : unit -> unit \ No newline at end of file diff --git a/test/blackbox-tests/test-cases/variants/resolution-priority/bar.ml b/test/blackbox-tests/test-cases/variants/resolution-priority/bar.ml new file mode 100644 index 00000000000..34fe3f89f61 --- /dev/null +++ b/test/blackbox-tests/test-cases/variants/resolution-priority/bar.ml @@ -0,0 +1,3 @@ +Direct.run ();; +Variant.run ();; +Test.run ();; diff --git a/test/blackbox-tests/test-cases/variants/resolution-priority/direct.c/direct.ml b/test/blackbox-tests/test-cases/variants/resolution-priority/direct.c/direct.ml new file mode 100644 index 00000000000..6dca9680b69 --- /dev/null +++ b/test/blackbox-tests/test-cases/variants/resolution-priority/direct.c/direct.ml @@ -0,0 +1 @@ +let run () = Printf.printf "hi from direct.c\n" \ No newline at end of file diff --git a/test/blackbox-tests/test-cases/variants/resolution-priority/direct.c/dune b/test/blackbox-tests/test-cases/variants/resolution-priority/direct.c/dune new file mode 100644 index 00000000000..fadb2cd6c14 --- /dev/null +++ b/test/blackbox-tests/test-cases/variants/resolution-priority/direct.c/dune @@ -0,0 +1,4 @@ +(library + (name direct_c) + (implements direct) + (variant c)) \ No newline at end of file diff --git a/test/blackbox-tests/test-cases/variants/resolution-priority/direct.default/direct.ml b/test/blackbox-tests/test-cases/variants/resolution-priority/direct.default/direct.ml new file mode 100644 index 00000000000..b1b6c3b4bd4 --- /dev/null +++ b/test/blackbox-tests/test-cases/variants/resolution-priority/direct.default/direct.ml @@ -0,0 +1 @@ +let run () = Printf.printf "hi from direct.default\n" \ No newline at end of file diff --git a/test/blackbox-tests/test-cases/variants/resolution-priority/direct.default/dune b/test/blackbox-tests/test-cases/variants/resolution-priority/direct.default/dune new file mode 100644 index 00000000000..d546eedbbf7 --- /dev/null +++ b/test/blackbox-tests/test-cases/variants/resolution-priority/direct.default/dune @@ -0,0 +1,5 @@ +(library + (name direct_default) + (implements direct) + (variant default) +) \ No newline at end of file diff --git a/test/blackbox-tests/test-cases/variants/resolution-priority/direct.ocaml/direct.ml b/test/blackbox-tests/test-cases/variants/resolution-priority/direct.ocaml/direct.ml new file mode 100644 index 00000000000..49a3fa551e7 --- /dev/null +++ b/test/blackbox-tests/test-cases/variants/resolution-priority/direct.ocaml/direct.ml @@ -0,0 +1 @@ +let run () = Printf.printf "hi from direct.ocaml\n" \ No newline at end of file diff --git a/test/blackbox-tests/test-cases/variants/resolution-priority/direct.ocaml/dune b/test/blackbox-tests/test-cases/variants/resolution-priority/direct.ocaml/dune new file mode 100644 index 00000000000..c4992c5741a --- /dev/null +++ b/test/blackbox-tests/test-cases/variants/resolution-priority/direct.ocaml/dune @@ -0,0 +1,5 @@ +(library + (name direct_ocaml) + (implements direct) + (variant ocaml) +) \ No newline at end of file diff --git a/test/blackbox-tests/test-cases/variants/resolution-priority/direct/direct.mli b/test/blackbox-tests/test-cases/variants/resolution-priority/direct/direct.mli new file mode 100644 index 00000000000..6879ed37434 --- /dev/null +++ b/test/blackbox-tests/test-cases/variants/resolution-priority/direct/direct.mli @@ -0,0 +1 @@ +val run : unit -> unit \ No newline at end of file diff --git a/test/blackbox-tests/test-cases/variants/resolution-priority/direct/dune b/test/blackbox-tests/test-cases/variants/resolution-priority/direct/dune new file mode 100644 index 00000000000..f82bfbdfe05 --- /dev/null +++ b/test/blackbox-tests/test-cases/variants/resolution-priority/direct/dune @@ -0,0 +1,6 @@ +(library + (name direct) + (virtual_modules direct) + (wrapped false) + (default_implementation direct_default) +) diff --git a/test/blackbox-tests/test-cases/variants/resolution-priority/dune b/test/blackbox-tests/test-cases/variants/resolution-priority/dune new file mode 100644 index 00000000000..fa5bc8f5d8f --- /dev/null +++ b/test/blackbox-tests/test-cases/variants/resolution-priority/dune @@ -0,0 +1,9 @@ +(executable + (name bar) + (libraries direct_ocaml variant) + (variants c) +) + +(alias + (name default) + (action (run ./bar.exe))) diff --git a/test/blackbox-tests/test-cases/variants/resolution-priority/dune-project b/test/blackbox-tests/test-cases/variants/resolution-priority/dune-project new file mode 100644 index 00000000000..fd5c747c687 --- /dev/null +++ b/test/blackbox-tests/test-cases/variants/resolution-priority/dune-project @@ -0,0 +1 @@ +(lang dune 1.7) \ No newline at end of file diff --git a/test/blackbox-tests/test-cases/variants/resolution-priority/test.default/dune b/test/blackbox-tests/test-cases/variants/resolution-priority/test.default/dune new file mode 100644 index 00000000000..62e84947359 --- /dev/null +++ b/test/blackbox-tests/test-cases/variants/resolution-priority/test.default/dune @@ -0,0 +1,5 @@ +(library + (name test_default) + (implements test) + (libraries direct) + (variant default)) \ No newline at end of file diff --git a/test/blackbox-tests/test-cases/variants/resolution-priority/test.default/test.ml b/test/blackbox-tests/test-cases/variants/resolution-priority/test.default/test.ml new file mode 100644 index 00000000000..962361a774d --- /dev/null +++ b/test/blackbox-tests/test-cases/variants/resolution-priority/test.default/test.ml @@ -0,0 +1 @@ +let run () = Printf.printf "hi from test.default\n" \ No newline at end of file diff --git a/test/blackbox-tests/test-cases/variants/resolution-priority/test/dune b/test/blackbox-tests/test-cases/variants/resolution-priority/test/dune new file mode 100644 index 00000000000..e9ea057e7d1 --- /dev/null +++ b/test/blackbox-tests/test-cases/variants/resolution-priority/test/dune @@ -0,0 +1,6 @@ +(library + (name test) + (virtual_modules test) + (wrapped false) + (default_implementation test_default) +) diff --git a/test/blackbox-tests/test-cases/variants/resolution-priority/test/test.mli b/test/blackbox-tests/test-cases/variants/resolution-priority/test/test.mli new file mode 100644 index 00000000000..6879ed37434 --- /dev/null +++ b/test/blackbox-tests/test-cases/variants/resolution-priority/test/test.mli @@ -0,0 +1 @@ +val run : unit -> unit \ No newline at end of file diff --git a/test/blackbox-tests/test-cases/variants/resolution-priority/variant.c/dune b/test/blackbox-tests/test-cases/variants/resolution-priority/variant.c/dune new file mode 100644 index 00000000000..1b318ec04ca --- /dev/null +++ b/test/blackbox-tests/test-cases/variants/resolution-priority/variant.c/dune @@ -0,0 +1,5 @@ +(library + (name variant_c) + (implements variant) + (libraries test) + (variant c)) diff --git a/test/blackbox-tests/test-cases/variants/resolution-priority/variant.c/variant.ml b/test/blackbox-tests/test-cases/variants/resolution-priority/variant.c/variant.ml new file mode 100644 index 00000000000..dbb38326ad5 --- /dev/null +++ b/test/blackbox-tests/test-cases/variants/resolution-priority/variant.c/variant.ml @@ -0,0 +1 @@ +let run () = Printf.printf "hi from variant.c\n" \ No newline at end of file diff --git a/test/blackbox-tests/test-cases/variants/resolution-priority/variant.default/dune b/test/blackbox-tests/test-cases/variants/resolution-priority/variant.default/dune new file mode 100644 index 00000000000..c8b79228b43 --- /dev/null +++ b/test/blackbox-tests/test-cases/variants/resolution-priority/variant.default/dune @@ -0,0 +1,5 @@ +(library + (name variant_default) + (implements variant) + (libraries test) + (variant default)) diff --git a/test/blackbox-tests/test-cases/variants/resolution-priority/variant.default/variant.ml b/test/blackbox-tests/test-cases/variants/resolution-priority/variant.default/variant.ml new file mode 100644 index 00000000000..3b623130b8a --- /dev/null +++ b/test/blackbox-tests/test-cases/variants/resolution-priority/variant.default/variant.ml @@ -0,0 +1 @@ +let run () = Printf.printf "hi from variant.default\n" \ No newline at end of file diff --git a/test/blackbox-tests/test-cases/variants/resolution-priority/variant/dune b/test/blackbox-tests/test-cases/variants/resolution-priority/variant/dune new file mode 100644 index 00000000000..8b42df305a3 --- /dev/null +++ b/test/blackbox-tests/test-cases/variants/resolution-priority/variant/dune @@ -0,0 +1,6 @@ +(library + (name variant) + (virtual_modules variant) + (wrapped false) + (default_implementation variant_default) +) diff --git a/test/blackbox-tests/test-cases/variants/resolution-priority/variant/variant.mli b/test/blackbox-tests/test-cases/variants/resolution-priority/variant/variant.mli new file mode 100644 index 00000000000..6879ed37434 --- /dev/null +++ b/test/blackbox-tests/test-cases/variants/resolution-priority/variant/variant.mli @@ -0,0 +1 @@ +val run : unit -> unit \ No newline at end of file diff --git a/test/blackbox-tests/test-cases/variants/run.t b/test/blackbox-tests/test-cases/variants/run.t index df25b75924f..74f057bcf94 100644 --- a/test/blackbox-tests/test-cases/variants/run.t +++ b/test/blackbox-tests/test-cases/variants/run.t @@ -339,6 +339,32 @@ Basic sample using variants and a default library. bar alias default hello from lib.test +Check that implementations are chosen according to manual specification, then +variants and finally default implementation. + $ dune build --root resolution-priority + Entering directory 'resolution-priority' + bar alias default + hi from direct.ocaml + hi from variant.c + hi from test.default + + +Check that ambiguity is handled correctly. + $ dune build --root dependency-cycle + Entering directory 'dependency-cycle' + Error: Default implementation cycle detected between the following libraries: + -> "clock" + -> "clock_ocaml" + -> "async_ocaml" + -> "async" + -> "async_c" + -> "clock_c" + -> "clock" + -> "test_default" + -> "test" + -> required by executable bar in dune:2 + [1] + Basic sample selecting implementation according to default library. $ dune build --root default-impl Entering directory 'default-impl' diff --git a/test/blackbox-tests/test-cases/variants/variants-base/lib/dune b/test/blackbox-tests/test-cases/variants/variants-base/lib/dune index 90503551340..14529f69a2c 100644 --- a/test/blackbox-tests/test-cases/variants/variants-base/lib/dune +++ b/test/blackbox-tests/test-cases/variants/variants-base/lib/dune @@ -2,5 +2,5 @@ (name vlib) (virtual_modules vlib) (wrapped false) - (default_implementation default) + (default_implementation lib.default) ) \ No newline at end of file