dune utop: don't select implementations

Signed-off-by: Lucas Pluvinage <lucas.pluvinage@gmail.com>

CHANGES.md

@@ -14,6 +14,10 @@
 1.11.0 (unreleased)
 -------------------
 
+- Don't select all local implementations in `dune utop`. Instead, let the
+  default implementation selection do its job. (#2327, fixes #2323, @TheLortex,
+  review by @rgrinberg)
+
 - Don't reserve the `Ppx` toplevel module name for ppx rewriters (#2242, @diml)
 
 - Redesign of the library variant feature according to the #2134 proposal. The

src/utop.ml

@@ -39,15 +39,20 @@ let libs_under_dir sctx ~db ~dir =
              begin match Lib.DB.find_even_when_hidden db
                            (Dune_file.Library.best_name l) with
              | None -> acc (* library is defined but outside our scope *)
-             | Some lib ->
+             | Some lib when should_be_selected lib ->
                (* still need to make sure that it's not coming from an external
                   source *)
                let info = Lib.info lib in
                let src_dir = Lib_info.src_dir info in
-               if Path.is_descendant ~of_:(Path.build dir) src_dir then
+               (* Only select libraries that are not implementations.
+                  Implementations are selected using the default implementation
+                  feature. *)
+               let not_impl = Option.is_none (Lib_info.implements info) in
+               if not_impl && Path.is_descendant ~of_:(Path.build dir) src_dir then
                  lib :: acc
                else
                  acc (* external lib with a name matching our private name *)
+              | _ -> acc
              end
            | _ ->
              acc)))

test/blackbox-tests/dune.inc

@@ -1448,6 +1448,14 @@
     (run %{exe:cram.exe} -skip-versions <4.05.0 -test run.t)
     (diff? run.t run.t.corrected)))))
 
+(alias
+ (name utop-default-implementation)
+ (deps (package dune) (source_tree test-cases/utop-default-implementation))
+ (action
+  (chdir
+   test-cases/utop-default-implementation
+   (progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
+
 (alias
  (name variants)
  (deps (package dune) (source_tree test-cases/variants))
@@ -1716,6 +1724,7 @@
   (alias use-meta)
   (alias utop)
   (alias utop-default)
+  (alias utop-default-implementation)
   (alias variants)
   (alias variants-external-declaration)
   (alias variants-external-declaration-conflict)
@@ -1880,6 +1889,7 @@
   (alias transitive-deps-mode)
   (alias unreadable-src)
   (alias upgrader)
+  (alias utop-default-implementation)
   (alias variants)
   (alias variants-external-declaration)
   (alias variants-external-declaration-conflict)

test/blackbox-tests/test-cases/utop-default-implementation/dune-project

@@ -0,0 +1,2 @@
+(lang dune 1.7)
+(using library_variants 0.1)

test/blackbox-tests/test-cases/utop-default-implementation/forutop-impl-2/dune

@@ -0,0 +1,3 @@
+(library
+ (name forutop_impl_2)
+ (implements forutop))

test/blackbox-tests/test-cases/utop-default-implementation/forutop-impl-2/forutop.ml

@@ -0,0 +1 @@
+let run () = print_endline "shouldn't be selected"

test/blackbox-tests/test-cases/utop-default-implementation/forutop-impl/dune

@@ -0,0 +1,3 @@
+(library
+ (name forutop_impl)
+ (implements forutop))

test/blackbox-tests/test-cases/utop-default-implementation/forutop-impl/forutop.ml

@@ -0,0 +1 @@
+let run () = print_endline "selected by default impl"

test/blackbox-tests/test-cases/utop-default-implementation/forutop/dune

@@ -0,0 +1,4 @@
+(library
+ (name forutop)
+ (virtual_modules forutop)
+ (default_implementation forutop_impl))

test/blackbox-tests/test-cases/utop-default-implementation/forutop/forutop.mli

@@ -0,0 +1 @@
+val run : unit -> unit

test/blackbox-tests/test-cases/utop-default-implementation/init_forutop.ml

@@ -0,0 +1 @@
+Forutop.run ();;

test/blackbox-tests/test-cases/utop-default-implementation/run.t

@@ -0,0 +1,2 @@
+  $ dune utop . init_forutop.ml
+  selected by default impl