Fix separate installation of implementations

CHANGES.md

@@ -14,6 +14,10 @@
 1.11.0 (unreleased)
 -------------------
 
+- When instantiating an implementation with a variant, make sure it matches
+  virtual library's list of known implementations. (#2361, fixes #2322, 
+  @TheLortex, review by @rgrinberg)
+
 - 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)

src/lib.ml

@@ -175,8 +175,41 @@ module Error = struct
           (Lib_name.to_string not_vlib)
           (Lib_name.to_string impl)
       ]
+
+  let vlib_known_implementation_mismatch ~loc ~name ~variant ~vlib_name =
+    make ~loc
+      [ Pp.textf "Virtual library %S does not know about implementation %S with \
+                  variant %S. Instead of using (variant %s) here, you need to \
+                  reference it in the virtual library project, using the \
+                  external_variant stanza:"
+          (Lib_name.to_string vlib_name)
+          (Lib_name.to_string name)
+          (Variant.to_string variant)
+          (Variant.to_string variant)
+      ; Pp.textf
+          "(external_variant\n\
+          \  (virtual_library %s)\n\
+          \  (variant %s)\n\
+          \  (implementation %s))"
+          (Lib_name.to_string vlib_name)
+          (Variant.to_string variant)
+          (Lib_name.to_string name)
+      ]
+
+  let vlib_variant_conflict ~loc ~name ~known_impl_name ~variant ~vlib_name =
+    make ~loc
+      [ Pp.textf "Implementation %S cannot have variant %S for virtual library \
+      %S as it is already defined for implementation %S."
+          (Lib_name.to_string name)
+          (Variant.to_string variant)
+          (Lib_name.to_string vlib_name)
+          (Lib_name.to_string known_impl_name)
+      ]
+
+
 end
 
+
 (* Types *)
 
 module Resolved_select = struct
@@ -908,49 +941,37 @@ end = struct
       resolve_dep db (name : Lib_name.t) ~allow_private_deps ~loc ~stack in
 
     let implements =
-      Lib_info.implements info
-      |> Option.map ~f:(fun ((loc,  _) as name) ->
-        let* vlib = resolve name in
-        let virtual_ = Lib_info.virtual_ vlib.info in
-        match virtual_ with
-        | None ->
-          Error.not_virtual_lib ~loc ~impl:info ~not_vlib:vlib.info
-        | Some _ ->
-          let variant = Lib_info.variant info in
-          match variant with
-          | None -> Ok vlib
-          | Some variant ->
-            (* If the library is an implementation tagged with a
-               variant, we must make sure that that it implements a
-               library that is part of the same project *)
-            let status_vlib = Lib_info.status vlib.info in
-            if Option.equal Dune_project.Name.equal
-                 (Lib_info.Status.project_name status)
-                 (Lib_info.Status.project_name status_vlib)
-            then
-              Ok vlib
-            else
-              let name = Lib_info.name info in
-              let name_vlib = Lib_info.name vlib.info in
-              User_error.raise ~loc
-                [ Pp.textf
-                    "Library implementation %s with variant %s implements a \
-                     library outside the project. Instead of using \
-                     (variant %S) here, you need to reference it in the \
-                     virtual library project, using the external_variant \
-                     stanza:"
-                    (Lib_name.to_string name)
-                    (Variant.to_string variant)
-                    (Variant.to_string variant)
-                ; Pp.textf
-                    "(external_variant\n\
-                    \  (virtual_library %s)\n\
-                    \  (variant %S)\n\
-                    \  (implementation %s))"
-                    (Lib_name.to_string name_vlib)
-                    (Variant.to_string variant)
-                    (Lib_name.to_string name)
-                ])
+      let open Option.O in
+      let+ ((loc, _) as name) = Lib_info.implements info in
+      let open Result.O in
+      let* vlib = resolve name in
+      let virtual_ = Lib_info.virtual_ vlib.info in
+      match virtual_ with
+      | None ->
+        Error.not_virtual_lib ~loc ~impl:info ~not_vlib:vlib.info
+      | Some _ ->
+        let variant = Lib_info.variant info in
+        begin match variant with
+        | None -> Ok vlib
+        | Some variant ->
+          (* If the library is an implementation tagged with a variant, we must
+              make sure that that it's correctly part of the virtual library's
+              known implementations. *)
+          let name = Lib_info.name info in
+          let vlib_name = Lib_info.name vlib.info in
+          let vlib_impls = Lib_info.known_implementations vlib.info in
+          let* (_, impl_name) =
+            match Variant.Map.find vlib_impls variant with
+            | None -> Error.vlib_known_implementation_mismatch
+                        ~loc ~name ~variant ~vlib_name
+            | Some impl_name -> Ok impl_name
+          in
+          if Lib_name.equal impl_name name then
+            Ok vlib
+          else
+            Error.vlib_variant_conflict
+              ~loc ~name ~known_impl_name:impl_name ~variant ~vlib_name
+        end
     in
     let resolve_impl impl_name =
       let* impl = resolve impl_name in

test/blackbox-tests/dune.inc

@@ -1524,6 +1524,14 @@
    test-cases/variants-only-package
    (progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
 
+(alias
+ (name variants-rogue-impl)
+ (deps (package dune) (source_tree test-cases/variants-rogue-impl))
+ (action
+  (chdir
+   test-cases/variants-rogue-impl
+   (progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
+
 (alias
  (name variants-wrong-external-declaration)
  (deps
@@ -1777,6 +1785,7 @@
   (alias variants-external-declaration-conflict)
   (alias variants-multi-project)
   (alias variants-only-package)
+  (alias variants-rogue-impl)
   (alias variants-wrong-external-declaration)
   (alias vlib)
   (alias vlib-default-impl)
@@ -1946,6 +1955,7 @@
   (alias variants-external-declaration-conflict)
   (alias variants-multi-project)
   (alias variants-only-package)
+  (alias variants-rogue-impl)
   (alias variants-wrong-external-declaration)
   (alias vlib)
   (alias vlib-default-impl)

test/blackbox-tests/test-cases/variants-multi-project/run.t

@@ -5,12 +5,12 @@ variant.
   File "prj2/dune", line 4, characters 13-20:
   4 |  (implements vlibfoo)
                    ^^^^^^^
-  Error: Library implementation impl with variant somevariant implements a
-  library outside the project. Instead of using (variant "somevariant") here,
-  you need to reference it in the virtual library project, using the
+  Error: Virtual library "vlibfoo" does not know about implementation "impl"
+  with variant "somevariant". Instead of using (variant somevariant) here, you
+  need to reference it in the virtual library project, using the
   external_variant stanza:
   (external_variant
     (virtual_library vlibfoo)
-    (variant "somevariant")
+    (variant somevariant)
     (implementation impl))
   [1]

test/blackbox-tests/test-cases/variants-only-package/project-2/impl2foo/dune

@@ -0,0 +1,6 @@
+(library
+ (name impl2foo)
+ (public_name impl2foo)
+ (implements vlibfoo)
+ (variant somevariant2)
+)

test/blackbox-tests/test-cases/variants-only-package/project/dune-project

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

test/blackbox-tests/test-cases/variants-only-package/project/implfoo/vlibfoo.ml

@@ -0,0 +1 @@
+let implme () = ()

test/blackbox-tests/test-cases/variants-only-package/run.t

@@ -1,9 +1,9 @@
 Check that local variant implementations are correctly exported in the list of
 known_implementations implementations when using -p
 
-  $ dune build -p vlibfoo
+  $ cd project && dune build -p vlibfoo
 
-  $ cat _build/install/default/lib/vlibfoo/dune-package
+  $ cat project/_build/install/default/lib/vlibfoo/dune-package
   (lang dune 1.11)
   (name vlibfoo)
   (library
@@ -21,3 +21,25 @@ known_implementations implementations when using -p
      (visibility public)
      (kind virtual)
      (intf))))
+
+Also check that the implementation correctly builds while using -p when part of the same project
+
+  $ cp -r project/_build/ opam
+
+  $ cd project && env OCAMLPATH=../opam/install/default/lib dune build -p implfoo
+
+And fail if it's not part of the same project.
+
+  $ cd project-2 && env OCAMLPATH=../opam/install/default/lib dune build -p impl2foo
+  File "impl2foo/dune", line 4, characters 13-20:
+  4 |  (implements vlibfoo)
+                   ^^^^^^^
+  Error: Virtual library "vlibfoo" does not know about implementation
+  "impl2foo" with variant "somevariant2". Instead of using (variant
+  somevariant2) here, you need to reference it in the virtual library project,
+  using the external_variant stanza:
+  (external_variant
+    (virtual_library vlibfoo)
+    (variant somevariant2)
+    (implementation impl2foo))
+  [1]

test/blackbox-tests/test-cases/variants-rogue-impl/prj1/dune

@@ -0,0 +1,10 @@
+(library
+ (name vlibfoo)
+ (public_name vlibfoo)
+ (virtual_modules vlibfoo))
+
+(external_variant
+  (virtual_library vlibfoo)
+  (variant somevariant)
+  (implementation real-impl))
+

test/blackbox-tests/test-cases/variants-rogue-impl/prj1/dune-project

@@ -0,0 +1,2 @@
+(lang dune 1.10)
+(using library_variants 0.2)

test/blackbox-tests/test-cases/variants-rogue-impl/prj1/vlibfoo.mli

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

test/blackbox-tests/test-cases/variants-rogue-impl/prj2/dune

@@ -0,0 +1,5 @@
+(library
+ (name impl)
+ (public_name impl)
+ (implements vlibfoo)
+ (variant somevariant))

test/blackbox-tests/test-cases/variants-rogue-impl/prj2/dune-project

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

test/blackbox-tests/test-cases/variants-rogue-impl/prj2/vlibfoo.ml

@@ -0,0 +1 @@
+let implme () = print_endline "foobar"

test/blackbox-tests/test-cases/variants-rogue-impl/run.t

@@ -0,0 +1,10 @@
+Implementation of library from another project is not allowed when tagged with
+variant.
+
+  $ dune build
+  File "prj2/dune", line 4, characters 13-20:
+  4 |  (implements vlibfoo)
+                   ^^^^^^^
+  Error: Implementation "impl" cannot have variant "somevariant" for virtual
+  library "vlibfoo" as it is already defined for implementation "real-impl".
+  [1]