summaryrefslogtreecommitdiff
path: root/tests
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
parenta840caccaee8c9492f4cc8a7ba802ef54391f199 (diff)
downloadguix-patches-f72f4b48c6777da9465ab17baa6762476d6cb270.tar
guix-patches-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')
-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))))