adds support for loading plugins in toplevels (#6082)

* adds support for loading plugins in toplevels Uses virtual libraries to select the proper dynamic linker facility. To load in the toplevel add `dune-site.toplevel` library as the dependency to your toplevel. 3. Also, handle moved load_file function. Prior to OCaml 4.13.0, the load_file function was in Topdirs. Starting with OCaml 4.13.0, the load_file function moved to Toploop. In order to find it open both these modules, suppressing the warning for unused open, and then reference load_file unqualified. Signed-off-by: Richard L Ford <[email protected]> Signed-off-by: ivg <[email protected]> Co-authored-by: Richard L Ford <[email protected]>
ocaml · Mar 7, 2023 · 086a78c · 086a78c
1 parent ac0f503
commit 086a78c
Show file tree

Hide file tree

Showing 14 changed files with 719 additions and 2 deletions.
diff --git a/CHANGES.md b/CHANGES.md
@@ -1,6 +1,9 @@
 Unreleased
 ----------
 
+- Adds support for loading plugins in toplevels (#6082, fixes #6081, 
+  @ivg, @richardlford)
+
 - Support commands that output 8-bit and 24-bit colors in the terminal (#7188,
   @Alizter)
 

diff --git a/doc/sites.rst b/doc/sites.rst
@@ -255,6 +255,12 @@ Main Executable (C)
 The generated module `sites` depends here also on the library
 `dune-site.plugins` because the `plugins` optional field is requested.
 
+If the executable being created is an OCaml toplevel, then the
+``libraries`` stanza needs to also include the ``dune-site.toplevel``
+library.  This causes the loading to use the toplevel's normal loading
+mechanism rather than ``Dynload.loadfile`` (which is not allowed in
+toplevels).
+
 - The module ``registration.ml`` of the library ``app.registration``:
 
 .. code:: ocaml

diff --git a/otherlibs/site/src/plugins/dune b/otherlibs/site/src/plugins/dune
@@ -6,6 +6,6 @@
   (dune_site
    (plugins)
    (data_module dune_site_plugins_data)))
- (libraries dune-site dune-private-libs.meta_parser dynlink)
+ (libraries dune-site dune-private-libs.meta_parser dune-site.linker)
  (instrumentation
   (backend bisect_ppx)))
diff --git a/otherlibs/site/src/plugins/linker/dune b/otherlibs/site/src/plugins/linker/dune
@@ -0,0 +1,11 @@
+(library
+ (name dune_site_backend)
+ (public_name dune-site.linker)
+ ; The linker module is virtual because it has two implementations
+ ; for load.
+ ; dune-site.dynlink implements it using Dynlink.loadfile
+ ; dune-site.toplevel implements it using
+ ; Topdirs.loadfile (before 4.13.0) or Toploop.loadfile (otherwise).
+ ; dune-site.toplevel is needed for OCaml toplevels with plugins.
+ (virtual_modules linker)
+ (default_implementation dune-site.dynlink))
diff --git a/otherlibs/site/src/plugins/linker/dynlink/dune b/otherlibs/site/src/plugins/linker/dynlink/dune
@@ -0,0 +1,5 @@
+(library
+ (name dune_site_dynlink_linker)
+ (public_name dune-site.dynlink)
+ (implements dune-site.linker)
+ (libraries dynlink))
diff --git a/otherlibs/site/src/plugins/linker/dynlink/linker.ml b/otherlibs/site/src/plugins/linker/dynlink/linker.ml
@@ -0,0 +1 @@
+let load = Dynlink.loadfile
diff --git a/otherlibs/site/src/plugins/linker/linker.mli b/otherlibs/site/src/plugins/linker/linker.mli
@@ -0,0 +1 @@
+val load : string -> unit
diff --git a/otherlibs/site/src/plugins/linker/toplevel/dune b/otherlibs/site/src/plugins/linker/toplevel/dune
@@ -0,0 +1,6 @@
+(library
+ (name dune_site_toplevel_linker)
+ (modes byte)
+ (public_name dune-site.toplevel)
+ (implements dune-site.linker)
+ (libraries compiler-libs.toplevel))
diff --git a/otherlibs/site/src/plugins/linker/toplevel/linker.ml b/otherlibs/site/src/plugins/linker/toplevel/linker.ml
@@ -0,0 +1,20 @@
+(*
+   Prior to OCaml 4.13.0, [load_file] was in the Topdirs module.
+   Beginning with OCaml 4.13.0, load_file is in the Toploop module.
+   In order to be able to compile with OCaml versions either
+   before or after, open both modules and let the compiler
+   find [load_file] where it is defined.
+*)
+open Topdirs [@@ocaml.warning "-33"]
+open Toploop [@@ocaml.warning "-33"]
+
+let load filename =
+  let buf = Buffer.create 16 in
+  let ppf = Format.formatter_of_buffer buf in
+  match load_file ppf filename with
+  | true -> ()
+  | false ->
+    Format.pp_print_flush ppf ();
+    failwith
+    @@ Format.asprintf "Failed to load file `%s': %s" filename
+         (Buffer.contents buf)
diff --git a/otherlibs/site/src/plugins/plugins.ml b/otherlibs/site/src/plugins/plugins.ml
@@ -256,7 +256,7 @@ let load_gen ~load_requires dirs name =
     List.iter
       (fun p ->
         let file = Filename.concat directory p in
-        Dynlink.loadfile file)
+        Dune_site_backend.Linker.load file)
       plugins)
 
 let rec load_requires name =

diff --git a/test/blackbox-tests/test-cases/sites-plugin.t b/test/blackbox-tests/test-cases/sites-plugin.t
@@ -0,0 +1,100 @@
+Test sites plugins (example from the manual)
+
+  $ cat > dune-project <<EOF
+  > (lang dune 3.8)
+  > (using dune_site 0.1)
+  > (name app)
+  > 
+  > (package
+  >  (name app)
+  >  (sites (lib plugins)))
+  > EOF
+
+  $ cat > dune <<EOF
+  > (executable
+  >  (public_name app)
+  >  (modules sites app)
+  >  (libraries app.register dune-site dune-site.plugins))
+  > 
+  > (library
+  >  (public_name app.register)
+  >  (name registration)
+  >  (modules registration))
+  > 
+  > (generate_sites_module
+  > (module sites)
+  > (plugins (app plugins)))
+  > EOF
+
+  $ cat > registration.ml <<EOF
+  > let todo : (unit -> unit) Queue.t = Queue.create ()
+  > EOF
+
+  $ cat > app.ml <<EOF
+  > (* load all the available plugins *)
+  > let () = Sites.Plugins.Plugins.load_all ()
+  > 
+  > let () = print_endline "Main app starts..."
+  > (* Execute the code registered by the plugins *)
+  > let () = Queue.iter (fun f -> f ()) Registration.todo
+  > EOF
+
+
+  $ mkdir plugin
+  $ cat > plugin/dune-project <<EOF
+  > (lang dune 3.8)
+  > (using dune_site 0.1)
+  > 
+  > (generate_opam_files true)
+  > 
+  > (package
+  >  (name plugin1))
+  > EOF
+
+  $ cat > plugin/dune <<EOF
+  > (library
+  >  (public_name plugin1.plugin1_impl)
+  >  (name plugin1_impl)
+  >  (modules plugin1_impl)
+  >  (libraries app.register))
+  > 
+  > (plugin
+  >  (name plugin1)
+  >  (libraries plugin1.plugin1_impl)
+  >  (site (app plugins)))
+  > EOF
+
+  $ cat > plugin/plugin1_impl.ml <<EOF
+  > let () =
+  > print_endline "Registration of Plugin1";
+  > Queue.add (fun () -> print_endline "Plugin1 is doing something...") Registration.todo
+  > EOF
+
+  $ dune build --display short @all 2>&1 | dune_cmd sanitize
+      ocamldep .app.eobjs/dune__exe__App.impl.d
+        ocamlc .registration.objs/byte/registration.{cmi,cmo,cmt}
+      ocamlopt .app.eobjs/native/dune_site__Dune_site_data.{cmx,o}
+      ocamlopt .app.eobjs/native/dune_site_plugins__Dune_site_plugins_data.{cmx,o}
+      ocamldep .app.eobjs/dune__exe__Sites.impl.d
+      ocamlopt .registration.objs/native/registration.{cmx,o}
+        ocamlc plugin/.plugin1_impl.objs/byte/plugin1_impl.{cmi,cmo,cmt}
+        ocamlc registration.cma
+        ocamlc .app.eobjs/byte/dune__exe.{cmi,cmo,cmt}
+      ocamldep .app.eobjs/dune__exe__App.intf.d
+      ocamlopt registration.{a,cmxa}
+      ocamlopt plugin/.plugin1_impl.objs/native/plugin1_impl.{cmx,o}
+        ocamlc plugin/plugin1_impl.cma
+      ocamlopt .app.eobjs/native/dune__exe.{cmx,o}
+        ocamlc .app.eobjs/byte/dune__exe__Sites.{cmi,cmo,cmt}
+        ocamlc .app.eobjs/byte/dune__exe__App.{cmi,cmti}
+      ocamlopt registration.cmxs
+      ocamlopt plugin/plugin1_impl.{a,cmxa}
+      ocamlopt .app.eobjs/native/dune__exe__Sites.{cmx,o}
+      ocamlopt .app.eobjs/native/dune__exe__App.{cmx,o}
+      ocamlopt plugin/plugin1_impl.cmxs
+      ocamlopt app.exe
+  $ dune exec ./app.exe
+  Registration of Plugin1
+  Main app starts...
+  Plugin1 is doing something...
+
diff --git a/test/blackbox-tests/test-cases/toplevel-plugin-fail.t b/test/blackbox-tests/test-cases/toplevel-plugin-fail.t
@@ -0,0 +1,184 @@
+Testsuite for (toplevel that loads plugins). This version
+uses ``dune-site.dynlink`` which uses ``Dynlink.loadfile``.
+This is not allowed in toplevels, so it fails.
+
+  $ cat > dune-project <<EOF
+  > (lang dune 3.7)
+  > (using dune_site 0.1)
+  > (name top_with_plugins)
+  > (wrapped_executables false)
+  > (map_workspace_root false)
+  > 
+  > (package
+  >  (name top_with_plugins)
+  >  (sites (lib top_plugins)))
+  > EOF
+
+  $ cat > dune <<EOF
+  > (executable
+  >  (public_name top_with_plugins)
+  >  (name top_with_plugins)
+  >  (modes byte)
+  >  (flags :standard -safe-string)
+  >  (modules sites top_with_plugins)
+  >  (link_flags (-linkall))
+  >  (libraries compiler-libs.toplevel
+  >   top_with_plugins.register dune-site dune-site.plugins 
+  >   dune-site.dynlink))
+  > 
+  > (library
+  >  (public_name top_with_plugins.register)
+  >  (modes byte)
+  >  (name registration)
+  >  (modules registration))
+  > 
+  > (generate_sites_module
+  >  (module sites)
+  >  (plugins (top_with_plugins top_plugins)))
+  > EOF
+
+  $ cat > top_with_plugins.ml <<EOF
+  > let main () =
+  >   print_endline "\nMain app really starts...";
+  >   (* load all the available plugins *)
+  >   Sites.Plugins.Top_plugins.load_all ();
+  >   print_endline "Main app after loading plugins...";
+  >   (* Execute the code registered by the plugins *)
+  >   print_endline "Main app executing registered plugins...";
+  >   Queue.iter (fun f -> f ()) Registration.todo;
+  >   print_endline "Main app after executing registered plugins...";
+  >   exit (Topmain.main ())
+  > 
+  > let () =
+  >     main()
+  > EOF
+
+  $ cat > registration.ml <<EOF
+  > let todo : (unit -> unit) Queue.t = Queue.create ()
+  > let register f =
+  >   print_endline "In register";
+  >   Queue.add f todo;
+  >   print_endline "Done in register";
+  > EOF
+
+  $ mkdir plugin1
+  $ cat > plugin1/dune-project <<EOF
+  > (lang dune 3.7)
+  > (using dune_site 0.1)
+  > 
+  > (generate_opam_files true)
+  > (wrapped_executables false)
+  > (map_workspace_root false)
+  > (package
+  >  (name top-plugin1))
+  > EOF
+
+  $ cat > plugin1/dune <<EOF
+  > (library
+  >  (public_name top-plugin1.plugin1_impl)
+  >  (modes byte)
+  >  (name plugin1_impl)
+  >  (modules plugin1_impl)
+  >  (libraries top_with_plugins.register))
+  > 
+  > (plugin
+  >  (name plugin1)
+  >  (libraries top-plugin1.plugin1_impl)
+  >  (site (top_with_plugins top_plugins)))
+  > EOF
+
+  $ cat > plugin1/plugin1_impl.ml <<EOF
+  > let myfun () =
+  >   print_endline "Plugin1 is doing something..."
+  > 
+  > let () =
+  >   print_endline "Registration of Plugin1";
+  >   Registration.register myfun;
+  >   print_endline "Done with registration of Plugin1";
+  > EOF
+
+  $ mkdir plugin2
+  $ cat > plugin2/dune-project <<EOF
+  > (lang dune 3.7)
+  > (using dune_site 0.1)
+  > 
+  > (generate_opam_files true)
+  > (wrapped_executables false)
+  > (map_workspace_root false)
+  > (package
+  >  (name top-plugin2))
+  > EOF
+
+  $ cat > plugin2/dune <<EOF
+  > (library
+  >  (public_name top-plugin2.plugin2_impl)
+  >  (modes byte)
+  >  (name plugin2_impl)
+  >  (modules plugin2_impl)
+  >  (libraries top_with_plugins.register))
+  > 
+  > (plugin
+  >  (name plugin2)
+  >  (libraries top-plugin2.plugin2_impl)
+  >  (site (top_with_plugins top_plugins)))
+  > EOF
+
+  $ cat > plugin2/plugin2_impl.ml <<EOF
+  > let myfun () =
+  >   print_endline "Plugin2 is doing something..."
+  > 
+  > let () =
+  >   print_endline "Registration of Plugin2";
+  >   Registration.register myfun;
+  >   print_endline "Done with registration of Plugin2";
+  > EOF
+
+  $ dune build --display short @all 2>&1 | dune_cmd sanitize
+      ocamldep .top_with_plugins.eobjs/top_with_plugins.impl.d
+        ocamlc .registration.objs/byte/registration.{cmi,cmo,cmt}
+        ocamlc .top_with_plugins.eobjs/byte/dune_site__Dune_site_data.{cmo,cmt}
+        ocamlc .top_with_plugins.eobjs/byte/dune_site_plugins__Dune_site_plugins_data.{cmo,cmt}
+      ocamldep .top_with_plugins.eobjs/sites.impl.d
+        ocamlc registration.cma
+        ocamlc plugin1/.plugin1_impl.objs/byte/plugin1_impl.{cmi,cmo,cmt}
+        ocamlc plugin2/.plugin2_impl.objs/byte/plugin2_impl.{cmi,cmo,cmt}
+        ocamlc .top_with_plugins.eobjs/byte/sites.{cmi,cmo,cmt}
+      ocamldep .top_with_plugins.eobjs/top_with_plugins.intf.d
+        ocamlc plugin1/plugin1_impl.cma
+        ocamlc plugin2/plugin2_impl.cma
+        ocamlc .top_with_plugins.eobjs/byte/top_with_plugins.{cmi,cmti}
+        ocamlc .top_with_plugins.eobjs/byte/top_with_plugins.{cmo,cmt}
+        ocamlc top_with_plugins.bc
+        ocamlc top_with_plugins.exe
+  $ dune install --prefix _install --display short
+  Installing _install/lib/top-plugin1/META
+  Installing _install/lib/top-plugin1/dune-package
+  Installing _install/lib/top-plugin1/plugin1_impl/plugin1_impl.cma
+  Installing _install/lib/top-plugin1/plugin1_impl/plugin1_impl.cmi
+  Installing _install/lib/top-plugin1/plugin1_impl/plugin1_impl.cmt
+  Installing _install/lib/top-plugin1/plugin1_impl/plugin1_impl.ml
+  Installing _install/lib/top_with_plugins/top_plugins/plugin1/META
+  Installing _install/lib/top-plugin2/META
+  Installing _install/lib/top-plugin2/dune-package
+  Installing _install/lib/top-plugin2/plugin2_impl/plugin2_impl.cma
+  Installing _install/lib/top-plugin2/plugin2_impl/plugin2_impl.cmi
+  Installing _install/lib/top-plugin2/plugin2_impl/plugin2_impl.cmt
+  Installing _install/lib/top-plugin2/plugin2_impl/plugin2_impl.ml
+  Installing _install/lib/top_with_plugins/top_plugins/plugin2/META
+  Installing _install/lib/top_with_plugins/META
+  Installing _install/lib/top_with_plugins/dune-package
+  Installing _install/lib/top_with_plugins/register/registration.cma
+  Installing _install/lib/top_with_plugins/register/registration.cmi
+  Installing _install/lib/top_with_plugins/register/registration.cmt
+  Installing _install/lib/top_with_plugins/register/registration.ml
+  Installing _install/bin/top_with_plugins
+  $ export OCAMLPATH=$PWD/_install/lib
+  $ ./_install/bin/top_with_plugins -no-version <<EOF
+  > 2+2;;
+  > #quit;;
+  > EOF
+
+  Main app really starts...
+  Fatal error: exception Invalid_argument("The dynlink.cma library cannot be used inside the OCaml toplevel")
+  [2]
+