summary refs log tree commit diff
path: root/tests/store.scm
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2021-09-15 16:23:48 +0200
committerLudovic Courtès <ludo@gnu.org>2021-09-15 16:52:13 +0200
commitf72f4b48c6777da9465ab17baa6762476d6cb270 (patch)
tree0f38dcacc02a9e5b3e37b3aeb85aceedef1ecf40 /tests/store.scm
parenta840caccaee8c9492f4cc8a7ba802ef54391f199 (diff)
downloadguix-f72f4b48c6777da9465ab17baa6762476d6cb270.tar.gz
store: 'map/accumulate-builds' processes the whole list in case of cutoff.
Fixes <https://issues.guix.gnu.org/50264>.
Reported by Lars-Dominik Braun <lars@6xq.net>.

This fixes a regression introduced in
fa81971cbae85b39183ccf8f51e8d96ac88fb4ac whereby 'map/accumulate-builds'
would return REST (the tail of LST) without applying PROC on it.  The
effect would be that 'lower-inputs' in (guix gexp) would dismiss those
elements, leading to derivations with correct builders but only a subset
of the inputs they should have had.

* guix/store.scm (map/accumulate-builds): Add #:cutoff parameter and
remove 'accumulation-cutoff' variable.  Call PROC on the elements of
REST.
* tests/store.scm ("map/accumulate-builds cutoff"): New test.
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 3266fa7a82..95f47c3af3 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))))