From fe95f17a501f044f31cfe385d61771a57206b748 Mon Sep 17 00:00:00 2001
From: Rudi Grinberg <me@rgrinberg.com>
Date: Sat, 25 May 2024 18:00:53 -0600
Subject: [PATCH] fix: virtual libraries bug (#10581)

When compiling an implementation of a virtual library, there's a check
that makes sure we don't the virtual library doesn't exist in the
closure of the implementation.

This check tried to compute the linking closure of the library to do so.
However, the linking closure might not be complete if the implementation
contains other virtual library.

To fix the issue, we use a "partial" linking closure that tries to
compute the closure as much as possible, but doesn't fail on missing
implementation.

Fix #10460

Signed-off-by: Rudi Grinberg <me@rgrinberg.com>
---
 src/dune_rules/lib.ml                         | 42 +++++++++++++------
 .../virtual-libraries/github10460.t           |  9 ----
 2 files changed, 29 insertions(+), 22 deletions(-)

diff --git a/src/dune_rules/lib.ml b/src/dune_rules/lib.ml
index 194881386fbf..85aec245bfd7 100644
--- a/src/dune_rules/lib.ml
+++ b/src/dune_rules/lib.ml
@@ -666,7 +666,10 @@ module Vlib : sig
       Additionally, if linking is [true], ensures that every virtual library as
       an implementation and re-arrange the list so that implementations replaces
       virtual libraries. *)
-  val associate : (t * Dep_stack.t) list -> linking:bool -> t list Resolve.Memo.t
+  val associate
+    :  (t * Dep_stack.t) list
+    -> [ `Compile | `Link | `Partial_link ]
+    -> t list Resolve.Memo.t
 
   module Unimplemented : sig
     (** set of unimplemented libraries*)
@@ -751,12 +754,12 @@ end = struct
 
     type t = lib Map.t
 
-    let make impls : t Resolve.Memo.t =
+    let make impls ~allow_partial : t Resolve.Memo.t =
       let rec loop acc = function
         | [] -> Resolve.Memo.return acc
-        | (vlib, Partial.No_impl stack) :: _ ->
+        | (vlib, Partial.No_impl stack) :: libs ->
           let rb = Dep_stack.to_required_by stack in
-          Error.no_implementation (vlib.info, rb)
+          if allow_partial then loop acc libs else Error.no_implementation (vlib.info, rb)
         | (vlib, Impl (impl, _stack)) :: libs -> loop (Map.set acc vlib impl) libs
       in
       loop Map.empty (Map.to_list impls)
@@ -794,12 +797,18 @@ end = struct
       List.rev res
   ;;
 
-  let associate closure ~linking =
+  let associate closure kind =
+    let linking, allow_partial =
+      match kind with
+      | `Compile -> false, true
+      | `Partial_link -> true, true
+      | `Link -> true, false
+    in
     let* impls = Table.Partial.make closure in
     let closure = List.map closure ~f:fst in
     if linking && not (Table.Partial.is_empty impls)
     then
-      let* impls = Table.make impls in
+      let* impls = Table.make impls ~allow_partial in
       second_step_closure closure impls
     else Resolve.Memo.return closure
   ;;
@@ -870,6 +879,8 @@ module rec Resolve_names : sig
     -> forbidden_libraries:Loc.t Map.t
     -> lib list Resolve.Memo.t
 
+  val check_forbidden : lib list -> forbidden_libraries:Loc.t Map.t -> unit Resolve.Memo.t
+
   val make_instantiate
     :  db Lazy.t
     -> (Lib_name.t -> Path.t Lib_info.t -> hidden:string option -> Status.t Memo.t)
@@ -955,7 +966,7 @@ end = struct
       | None -> Memo.return requires
       | Some vlib ->
         let open Resolve.Memo.O in
-        let* (_ : lib list) =
+        let* () =
           let* vlib = Memo.return vlib in
           let* requires_for_closure_check =
             Memo.return
@@ -963,8 +974,7 @@ end = struct
                let+ requires = requires in
                List.filter requires ~f:(fun lib -> not (equal lib vlib)))
           in
-          linking_closure_with_overlap_checks
-            None
+          check_forbidden
             requires_for_closure_check
             ~forbidden_libraries:(Map.singleton vlib Loc.none)
         in
@@ -1662,9 +1672,9 @@ end = struct
       include M
     end
 
-    let result computation ~linking =
+    let result computation kind =
       let* state, () = R.run computation R.empty_state in
-      Vlib.associate (List.rev state.result) ~linking
+      Vlib.associate (List.rev state.result) kind
     ;;
 
     let rec visit (t : t) ~stack (implements_via, lib) =
@@ -1728,7 +1738,7 @@ end = struct
 
   let compile_closure_with_overlap_checks db ts ~forbidden_libraries =
     let _closure, state = step1_closure db ts ~forbidden_libraries in
-    Closure.result state ~linking:false
+    Closure.result state `Compile
   ;;
 
   let linking_closure_with_overlap_checks db ts ~forbidden_libraries =
@@ -1754,7 +1764,13 @@ end = struct
       in
       state >>> impls_via_defaults ()
     in
-    Closure.result res ~linking:true
+    Closure.result res `Link
+  ;;
+
+  let check_forbidden ts ~forbidden_libraries =
+    let _closure, state = step1_closure None ts ~forbidden_libraries in
+    let+ (_ : lib list) = Closure.result state `Partial_link in
+    ()
   ;;
 end
 
diff --git a/test/blackbox-tests/test-cases/virtual-libraries/github10460.t b/test/blackbox-tests/test-cases/virtual-libraries/github10460.t
index 9df31cb3d831..e8221406a885 100644
--- a/test/blackbox-tests/test-cases/virtual-libraries/github10460.t
+++ b/test/blackbox-tests/test-cases/virtual-libraries/github10460.t
@@ -52,12 +52,3 @@ Reproduces the issue reported in #10460
   > EOF
 
   $ dune build main.exe
-  Error: No implementation found for virtual library "vlib1" in
-  _build/default/vlib1.
-  -> required by library "lib" in _build/default/lib
-  -> required by library "impl2" in _build/default/impl2
-  -> required by executable main in dune:2
-  -> required by _build/default/.main.eobjs/byte/dune__exe__Main.cmi
-  -> required by _build/default/.main.eobjs/native/dune__exe__Main.cmx
-  -> required by _build/default/main.exe
-  [1]