diff --git a/CHANGES.md b/CHANGES.md index 6ab5f92f668..0bf915b057d 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -1,6 +1,8 @@ Unreleased ---------- +- Fix plugins with dot in the name (#5182, @bobot, review @rgrinberg) + - Fix installation of implementations of virtual libraries (#5150, fix #3636, @rgrinberg) diff --git a/otherlibs/site/src/plugins/plugins.ml b/otherlibs/site/src/plugins/plugins.ml index e7455cafe60..6e27af5f83b 100644 --- a/otherlibs/site/src/plugins/plugins.ml +++ b/otherlibs/site/src/plugins/plugins.ml @@ -7,6 +7,16 @@ let readdir dirs = (fun dir -> Array.to_list (Sys.readdir dir)) (List.filter Sys.file_exists dirs)) +let rec lookup dirs file = + match dirs with + | [] -> None + | dir :: dirs -> + let file' = Filename.concat dir file in + if Sys.file_exists file' then + Some file' + else + lookup dirs file + module type S = sig val paths : string list @@ -57,11 +67,49 @@ let rec get_plugin plugins requires entries = get_plugin plugins (value :: requires) entries | Rule _ :: entries -> get_plugin plugins requires entries -exception Library_not_found of string - exception Thread_library_required_by_plugin_but_not_required_by_main_executable -let rec find_library ~suffix directory meta = +exception + Library_not_found of + { search_paths : string list + ; prefix : string list + ; name : string + } + +exception + Plugin_not_found of + { search_paths : string list + ; name : string + } + +let () = + Printexc.register_printer (function + | Thread_library_required_by_plugin_but_not_required_by_main_executable -> + Some + (Format.asprintf "%a" Format.pp_print_text + "It is not possible to dynamically link a plugin which uses the \ + thread library with an executable not already linked with the \ + thread library.") + | Plugin_not_found { search_paths; name } -> + Some + (Format.sprintf "The plugin %S can't be found in the search paths %S." + name + (String.concat ":" search_paths)) + | Library_not_found { search_paths; prefix = []; name } -> + Some + (Format.sprintf "The library %S can't be found in the search paths %S." + name + (String.concat ":" search_paths)) + | Library_not_found { search_paths; prefix; name } -> + Some + (Format.sprintf + "The sub-library %S can't be found in the library %s in the search \ + paths %S." + name (String.concat "." prefix) + (String.concat ":" search_paths)) + | _ -> None) + +let rec find_library ~dirs ~prefix ~suffix directory meta = let rec find_directory directory = function | [] -> directory | Meta_parser.Rule @@ -77,10 +125,13 @@ let rec find_library ~suffix directory meta = | pkg :: suffix -> let directory = find_directory directory meta in let rec aux pkg = function - | [] -> raise (Library_not_found pkg) + | [] -> + raise + (Library_not_found + { search_paths = dirs; prefix = List.rev prefix; name = pkg }) | Meta_parser.Package { name = Some name; entries } :: _ when String.equal name pkg -> - find_library ~suffix directory entries + find_library ~dirs ~prefix:(pkg :: prefix) ~suffix directory entries | _ :: entries -> aux pkg entries in aux pkg meta @@ -114,8 +165,11 @@ let extract_comma_space_separated_words s = let split_all l = List.concat (List.map extract_comma_space_separated_words l) -let find_plugin ~dir ~suffix meta = - let directory, meta = find_library ~suffix None meta.Meta_parser.entries in +let find_plugin ~dirs ~dir ~suffix (meta : Meta_parser.t) = + let directory, meta = + find_library ~dirs ~prefix:(Option.to_list meta.name) ~suffix None + meta.entries + in let plugins, requires = get_plugin [] [] meta in let directory = match directory with @@ -166,26 +220,28 @@ let lookup_and_load_one_dir ~dir ~pkg = else None -let split name = +let split ~dirs name = match String.split_on_char '.' name with - | [] -> raise (Library_not_found name) + | [] -> raise (Library_not_found { search_paths = dirs; prefix = []; name }) | pkg :: rest -> (pkg, rest) -let lookup_and_summarize dirs name = - let pkg, suffix = split name in +let lookup_and_summarize alldirs name = + let pkg, suffix = split ~dirs:alldirs name in let rec loop dirs = match dirs with | [] -> ( List.assoc_opt pkg Data.builtin_library |> function - | None -> raise (Library_not_found name) - | Some meta -> find_plugin ~dir:(Lazy.force Helpers.stdlib) ~suffix meta) + | None -> + raise (Library_not_found { search_paths = alldirs; prefix = []; name }) + | Some meta -> + find_plugin ~dirs:alldirs ~dir:(Lazy.force Helpers.stdlib) ~suffix meta) | dir :: dirs -> ( let dir = Filename.concat dir pkg in match lookup_and_load_one_dir ~dir ~pkg with | None -> loop dirs - | Some p -> find_plugin ~dir ~suffix p) + | Some p -> find_plugin ~dirs:alldirs ~dir ~suffix p) in - loop dirs + loop alldirs let loaded_libraries = lazy @@ -212,7 +268,15 @@ let load_gen ~load_requires dirs name = let rec load_requires name = load_gen ~load_requires (Lazy.force Helpers.ocamlpath) name -let load_plugin plugin_paths name = load_gen ~load_requires plugin_paths name +let load_plugin plugin_paths name = + match lookup plugin_paths (Filename.concat name meta_fn) with + | None -> raise (Plugin_not_found { search_paths = plugin_paths; name }) + | Some meta_file -> + let meta = load meta_file ~pkg:name in + let plugins, requires = get_plugin [] [] meta.entries in + assert (plugins = []); + let requires = split_all requires in + List.iter load_requires requires module Make (X : sig val paths : string list diff --git a/otherlibs/site/test/plugin_require_thread.t/run.t b/otherlibs/site/test/plugin_require_thread.t/run.t index 1f70a015e24..488ebd1503f 100644 --- a/otherlibs/site/test/plugin_require_thread.t/run.t +++ b/otherlibs/site/test/plugin_require_thread.t/run.t @@ -2,7 +2,9 @@ $ dune build ./app.exe @install $ dune exec ./app.exe The library is being used by two plugins finished initialization - Error during dynamic linking: Dune_site_plugins__Plugins.Thread_library_required_by_plugin_but_not_required_by_main_executableMain app starts... + Error during dynamic linking: It is not possible to dynamically link a plugin which uses the thread library + with an executable not already linked with the thread + library.Main app starts... $ sed -e "s/;TOREMOVE//" dune > dune.tmp $ mv -f dune.tmp dune diff --git a/otherlibs/site/test/plugin_with_dot.t b/otherlibs/site/test/plugin_with_dot.t new file mode 100644 index 00000000000..a423475e0d9 --- /dev/null +++ b/otherlibs/site/test/plugin_with_dot.t @@ -0,0 +1,106 @@ + $ mkdir -p b c + + $ for i in b; do + > mkdir -p $i + > cat >$i/dune-project < (lang dune 3.0) + > (using dune_site 0.1) + > (name $i) + > (package (name $i) (depends c)) + > EOF + > done + + $ for i in c; do + > mkdir -p $i + > cat >$i/dune-project < (lang dune 3.0) + > (using dune_site 0.1) + > (name $i) + > (package (name $i) (sites (share data) (lib plugins))) + > EOF + > done + + $ cat >b/dune < (library + > (public_name b.b.b) + > (name b) + > (libraries c.register dune-site)) + > (generate_sites_module (module sites) (sites b)) + > (plugin (name c-plugins-b.b) (libraries b.b.b) (site (c plugins))) + > EOF + + $ cat >b/b.ml < let v = "b" + > let () = Printf.printf "run b\n%!" + > let () = C_register.registered := "b"::!C_register.registered + > EOF + + $ cat >c/dune < (executable + > (public_name c) + > (promote (until-clean)) + > (modules c sites) + > (libraries c.register dune-site dune-site.plugins)) + > (library + > (public_name c.register) + > (name c_register) + > (modules c_register)) + > (generate_sites_module (module sites) (plugins (c plugins))) + > (rule + > (targets out.log) + > (deps (package c)) + > (action (with-stdout-to out.log (run %{bin:c} "c-plugins-b.b")))) + > EOF + + $ cat >c/c_register.ml < let registered : string list ref = ref [] + > EOF + + $ cat >c/c.ml < let () = try Sites.Plugins.Plugins.load Sys.argv.(1) + > with exn -> print_endline (Printexc.to_string exn) + > let () = Printf.printf "run c: registered:%s.\n%!" (String.concat "," !C_register.registered) + > EOF + + $ cat > dune-project << EOF + > (lang dune 2.2) + > EOF + +Build everything +---------------- + + $ dune build + +Test with dune exec +-------------------------------- + $ dune exec -- c/c.exe "c-plugins-b.b" + run b + run c: registered:b. + +Test error messages +-------------------------------- + $ dune exec -- c/c.exe "inexistent" + The plugin "inexistent" can't be found in the search paths "$TESTCASE_ROOT/_build/install/default/lib/c/plugins". + run c: registered:. + + $ cat >c/c.ml < let l = Lazy.force Dune_site.Private_.Helpers.ocamlpath + > let l = List.map (Printf.sprintf "OCAMLPATH=%s") l + > let () = print_string (String.concat ":" l) + > EOF + + $ export BUILD_PATH_PREFIX_MAP="$(dune exe -- c/c.exe):$BUILD_PATH_PREFIX_MAP" + + $ cat >c/c.ml < let () = try Dune_site_plugins.V1.load Sys.argv.(1) + > with exn -> print_endline (Printexc.to_string exn) + > EOF + + $ dune exec -- c/c.exe "inexistent" 2>&1 | sed -e 's&default/lib:.*&default/lib:..."&g' + The library "inexistent" can't be found in the search paths "$TESTCASE_ROOT/_build/install/default/lib:..." + + $ dune exec -- c/c.exe "b.b.b" + run b + + $ dune exec -- c/c.exe "b.b.inexistent" 2>&1 | sed -e 's&default/lib:.*&default/lib:..."&g' + The sub-library "inexistent" can't be found in the library b.b in the search paths "$TESTCASE_ROOT/_build/install/default/lib:..."