summary refs log tree commit diff
path: root/tests/store.scm
diff options
context:
space:
mode:
authorMarius Bakke <marius@gnu.org>2021-09-17 01:25:52 +0200
committerMarius Bakke <marius@gnu.org>2021-09-17 01:25:52 +0200
commit5c3cb22c9b2810669999e044b2de5e9331011a83 (patch)
tree3276e19cc1a0af3cece6ce4f2bfa930901888bb4 /tests/store.scm
parentc896287ce5eff968a0b323f3a069653a64b96b4c (diff)
parent2a054d29dcfd4b68ed3914886b637f93ac7a0a72 (diff)
downloadguix-5c3cb22c9b2810669999e044b2de5e9331011a83.tar.gz
Merge branch 'master' into core-updates-frozen
 Conflicts:
	gnu/packages/bioinformatics.scm
	gnu/packages/chez.scm
	gnu/packages/docbook.scm
	gnu/packages/ebook.scm
	gnu/packages/gnome.scm
	gnu/packages/linux.scm
	gnu/packages/networking.scm
	gnu/packages/python-web.scm
	gnu/packages/python-xyz.scm
	gnu/packages/tex.scm
	gnu/packages/version-control.scm
	gnu/packages/xml.scm
	guix/build-system/dune.scm
	guix/build-system/go.scm
	guix/build-system/linux-module.scm
	guix/packages.scm
Diffstat (limited to 'tests/store.scm')
-rw-r--r--tests/store.scm36
1 files changed, 36 insertions, 0 deletions
diff --git a/tests/store.scm b/tests/store.scm
index d77c26192a..d895a328a4 100644
--- a/tests/store.scm
+++ b/tests/store.scm
@@ -454,6 +454,42 @@
                                              (derivation->output-path drv)))
                              (list d1 d2)))))
 
+(test-equal "map/accumulate-builds cutoff" ;https://issues.guix.gnu.org/50264
+  (iota 20)
+
+  ;; Make sure that, when the cutoff is reached, 'map/accumulate-builds' still
+  ;; returns the right result and calls the build handler by batches.
+  (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))))
+         (d  (map (lambda (i)
+                    (derivation %store (string-append "the-thing-"
+                                                      (number->string i))
+                                s `("-e" ,b)
+                                #:env-vars `(("foo" . ,(random-text)))
+                                #:sources (list b s)
+                                #:properties `((n . ,i))))
+                  (iota 20)))
+         (calls '()))
+    (define lst
+      (with-build-handler (lambda (continue store things mode)
+                            (set! calls (cons things calls))
+                            (continue #f))
+        (map/accumulate-builds %store
+                               (lambda (d)
+                                 (build-derivations %store (list d))
+                                 (assq-ref (derivation-properties d) 'n))
+                               d
+                               #:cutoff 7)))
+
+    (match (reverse calls)
+      (((batch1 ...) (batch2 ...) (batch3 ...))
+       (and (equal? (map derivation-file-name (take d 8)) batch1)
+            (equal? (map derivation-file-name (take (drop d 8) 8)) batch2)
+            (equal? (map derivation-file-name (drop d 16)) batch3)
+            lst)))))
+
 (test-assert "mapm/accumulate-builds"
   (let* ((d1 (run-with-store %store
                (gexp->derivation "foo" #~(mkdir #$output))))