In dune utop, stop selecting all local implementations

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

@@ -22,6 +22,13 @@ let source ~dir =
 
 let is_utop_dir dir = Path.Build.basename dir = utop_dir_basename
 
+(* Only select libraries that are not implementations. Implementations are
+   selected using the default implementation feature. *)
+let should_be_selected lib =
+  Lib.info lib
+  |> Lib_info.implements
+  |> Option.is_none
+
 let libs_under_dir sctx ~db ~dir =
   (let open Option.O in
    let* dir = Path.drop_build_context dir in
@@ -39,7 +46,7 @@ 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
@@ -48,6 +55,7 @@ let libs_under_dir sctx ~db ~dir =
                  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