From c40bf5816cb3ffb59920a61f71bd34b53cac3637 Mon Sep 17 00:00:00 2001
From: Ludovic Courtès <ludo@gnu.org>
Date: Wed, 25 Mar 2020 12:41:18 +0100
Subject: store: Add 'map/accumulate-builds'.

* guix/store.scm (<unresolved>): New record type.
(build-accumulator, map/accumulate-builds, mapm/accumulate-builds): New
procedures.
* tests/store.scm ("map/accumulate-builds", "mapm/accumulate-builds"):
New tests.
---
 tests/store.scm | 36 ++++++++++++++++++++++++++++++++++++
 1 file changed, 36 insertions(+)

(limited to 'tests')

diff --git a/tests/store.scm b/tests/store.scm
index b61a981b28..0458a34746 100644
--- a/tests/store.scm
+++ b/tests/store.scm
@@ -412,6 +412,42 @@
       (build-derivations %store (list d2))
       'fail)))
 
+(test-assert "map/accumulate-builds"
+  (let* ((b  (add-text-to-store %store "build" "echo $foo > $out" '()))
+         (s  (add-to-store %store "bash" #t "sha256"
+                           (search-bootstrap-binary "bash"
+                                                    (%current-system))))
+         (d1 (derivation %store "the-thing"
+                         s `("-e" ,b)
+                         #:env-vars `(("foo" . ,(random-text)))
+                         #:sources (list b s)))
+         (d2 (derivation %store "the-thing"
+                         s `("-e" ,b)
+                         #:env-vars `(("foo" . ,(random-text))
+                                      ("bar" . "baz"))
+                         #:sources (list b s))))
+    (with-build-handler (lambda (continue store things mode)
+                          (equal? (map derivation-file-name (list d1 d2))
+                                  things))
+      (map/accumulate-builds %store
+                             (lambda (drv)
+                               (build-derivations %store (list drv))
+                               (add-to-store %store "content-addressed"
+                                             #t "sha256"
+                                             (derivation->output-path drv)))
+                             (list d1 d2)))))
+
+(test-assert "mapm/accumulate-builds"
+  (let* ((d1 (run-with-store %store
+               (gexp->derivation "foo" #~(mkdir #$output))))
+         (d2 (run-with-store %store
+               (gexp->derivation "bar" #~(mkdir #$output)))))
+    (with-build-handler (lambda (continue store things mode)
+                          (equal? (map derivation-file-name (pk 'zz (list d1 d2)))
+                                  (pk 'XX things)))
+      (run-with-store %store
+        (mapm/accumulate-builds built-derivations `((,d1) (,d2)))))))
+
 (test-assert "topologically-sorted, one item"
   (let* ((a (add-text-to-store %store "a" "a"))
          (b (add-text-to-store %store "b" "b" (list a)))
-- 
cgit v1.2.3