Bug fix using current primitives

ocurrent · Mar 27, 2024 · 2577bcf · 2577bcf
1 parent 162187d
commit 2577bcf
Show file tree

Hide file tree

Showing 6 changed files with 51 additions and 32 deletions.
diff --git a/lib/build.ml b/lib/build.ml
@@ -143,12 +143,10 @@ let extras ~build =
     switches @ arches @ acc
   ) [] default_compilers_full
 
-let test_revdeps (module Builder : Build_intf.S) ~opam_version ~master ~base ~variant ~pkgopt ~after ~all_new_pkgs source =
+let test_revdeps (module Builder : Build_intf.S) ~opam_version ~master ~base ~variant ~pkgopt ~after ~new_pkgs source =
   let revdeps =
-    let* all_new_pkgs in
-    Builder.list_revdeps ~opam_version ~base ~variant ~pkgopt ~master ~after source
-    |> Current.map (fun p -> 
-      OpamPackage.Set.(elements @@ filter (fun p -> not @@ List.mem p all_new_pkgs) p))
+    Builder.list_revdeps ~opam_version ~base ~variant ~pkgopt ~new_pkgs ~master ~after source
+    |> Current.map OpamPackage.Set.elements
   in
   let pkg = Current.map (fun pkgopt -> pkgopt.Package_opt.pkg) pkgopt in
   let urgent = Current.map (fun pkgopt -> pkgopt.Package_opt.urgent) pkgopt in
@@ -223,7 +221,7 @@ let build (module Builder : Build_intf.S) ~analysis ~pkgopts ~master ~source ~op
     and revdeps =
       if revdeps then
         test_revdeps (module Builder) ~opam_version ~master ~base ~variant
-          ~pkgopt source ~after:image ~all_new_pkgs:pkgs
+          ~pkgopt source ~after:image ~new_pkgs:pkgs
       else Node.empty
     in
     let label = Current.map OpamPackage.to_string pkg in

diff --git a/lib/build_intf.ml b/lib/build_intf.ml
@@ -23,6 +23,7 @@ module type S = sig
     variant:Variant.t ->
     opam_version:[`V2_0 | `V2_1 | `Dev] ->
     pkgopt:Package_opt.t Current.t ->
+    new_pkgs:OpamPackage.t list Current.t ->
     base:Spec.base Current.t ->
     master:Current_git.Commit.t Current.t ->
     after:unit Current.t ->

diff --git a/lib/cluster_build.ml b/lib/cluster_build.ml
@@ -170,9 +170,28 @@ let v t ~label ~spec ~base ~master ~urgent commit =
   BC.get t { Op.Key.pool; commit; variant; ty }
   |> Current.Primitive.map_result (Result.map ignore) (* TODO: Create a separate type of cache that doesn't parse the output *)
 
-let list_revdeps t ~variant ~opam_version ~pkgopt ~base ~master ~after commit =
+let parse_revdeps ~pkg =
+  Result.map (fun output ->
+    String.split_on_char '\n' output
+    |> List.fold_left (fun acc -> function
+      | "" -> acc
+      | revdep ->
+          let revdep = OpamPackage.of_string revdep in
+          if OpamPackage.equal pkg revdep then
+            acc (* NOTE: opam list --recursive --depends-on <pkg> also returns <pkg> itself *)
+          else
+            OpamPackage.Set.add revdep acc
+    ) OpamPackage.Set.empty
+  )
+
+(* Don't include new packages that we're adding in the revdeps, as these are already tested *)
+let filter_new_pkgs ~new_pkgs =
+  Result.map @@ OpamPackage.Set.filter (fun p -> not @@ List.mem p new_pkgs)
+
+let list_revdeps t ~variant ~opam_version ~pkgopt ~new_pkgs ~base ~master ~after commit =
   Current.component "list revdeps" |>
   let> {Package_opt.pkg; urgent; has_tests = _} = pkgopt
+  and> new_pkgs
   and> base
   and> commit
   and> master
@@ -181,15 +200,5 @@ let list_revdeps t ~variant ~opam_version ~pkgopt ~base ~master ~after commit =
   let t = { Op.config = t; master; urgent; base } in
   let ty = `Opam (`List_revdeps {Spec.opam_version}, pkg) in
   BC.get t { Op.Key.pool; commit; variant; ty }
-  |> Current.Primitive.map_result (Result.map (fun output ->
-      String.split_on_char '\n' output |>
-      List.fold_left (fun acc -> function
-          | "" -> acc
-          | revdep ->
-              let revdep = OpamPackage.of_string revdep in
-              if OpamPackage.equal pkg revdep then
-                acc (* NOTE: opam list --recursive --depends-on <pkg> also returns <pkg> itself *)
-              else
-                OpamPackage.Set.add revdep acc
-        ) OpamPackage.Set.empty
-    ))
+  |> Current.Primitive.map_result (parse_revdeps ~pkg)
+  |> Current.Primitive.map_result (filter_new_pkgs ~new_pkgs)
diff --git a/lib/cluster_build.mli b/lib/cluster_build.mli
@@ -32,6 +32,7 @@ val list_revdeps :
   variant:Variant.t ->
   opam_version:[`V2_0 | `V2_1 | `Dev] ->
   pkgopt:Package_opt.t Current.t ->
+  new_pkgs:OpamPackage.t list Current.t ->
   base:Spec.base Current.t ->
   master:Current_git.Commit.t Current.t ->
   after:unit Current.t ->

diff --git a/lib/local_build.ml b/lib/local_build.ml
@@ -213,26 +213,35 @@ let v ~label ~spec ~base ~master ~urgent commit =
   BC.get t { commit; ty; variant }
   |> Current.Primitive.map_result (Result.map ignore) (* TODO: Create a separate type of cache that doesn't parse the output *)
 
-let list_revdeps ~variant ~opam_version ~pkgopt ~base ~master ~after commit =
+let parse_revdeps ~pkg =
+  Result.map (fun output ->
+    String.split_on_char '\n' output
+    |> List.fold_left (fun acc -> function
+      | "" -> acc
+      | revdep ->
+          let revdep = OpamPackage.of_string revdep in
+          if OpamPackage.equal pkg revdep then
+            acc (* NOTE: opam list --recursive --depends-on <pkg> also returns <pkg> itself *)
+          else
+            OpamPackage.Set.add revdep acc
+    ) OpamPackage.Set.empty
+  )
+
+(* Don't include new packages that we're adding in the revdeps, as these are already tested *)
+let filter_new_pkgs ~new_pkgs =
+  Result.map @@ OpamPackage.Set.filter (fun p -> not @@ List.mem p new_pkgs)
+
+let list_revdeps ~variant ~opam_version ~pkgopt ~new_pkgs ~base ~master ~after commit =
   let label = "list revdeps" in
   Current.component "%s" label |>
   let> {Package_opt.pkg; urgent; has_tests = _} = pkgopt
+  and> new_pkgs
   and> base
   and> commit = Git.fetch commit
   and> master
   and> () = after in
   let t = { Op.config = local_builder; master; urgent; base } in
   let ty = `Opam (`List_revdeps {Spec.opam_version}, pkg) in
   BC.get t { commit; ty; variant }
-  |> Current.Primitive.map_result (Result.map (fun output ->
-      String.split_on_char '\n' output |>
-      List.fold_left (fun acc -> function
-          | "" -> acc
-          | revdep ->
-              let revdep = OpamPackage.of_string revdep in
-              if OpamPackage.equal pkg revdep then
-                acc (* NOTE: opam list --recursive --depends-on <pkg> also returns <pkg> itself *)
-              else
-                OpamPackage.Set.add revdep acc
-        ) OpamPackage.Set.empty
-    ))
+  |> Current.Primitive.map_result (parse_revdeps ~pkg)
+  |> Current.Primitive.map_result (filter_new_pkgs ~new_pkgs)
diff --git a/lib/local_build.mli b/lib/local_build.mli
@@ -22,6 +22,7 @@ val list_revdeps :
   variant:Variant.t ->
   opam_version:[ `Dev | `V2_0 | `V2_1 ] ->
   pkgopt:Package_opt.t Current.t ->
+  new_pkgs:OpamPackage.t list Current.t ->
   base:Spec.base Current.t ->
   master:Current_git.Commit.t Current.t ->
   after:unit Current.t ->