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)
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 3266fa7a82d..95f47c3af3c 100644
--- a/tests/store.scm
+++ b/tests/store.scm
@@ -454,6 +454,42 @@
454 (derivation->output-path drv))) 454 (derivation->output-path drv)))
455 (list d1 d2))))) 455 (list d1 d2)))))
456 456
457(test-equal "map/accumulate-builds cutoff" ;https://issues.guix.gnu.org/50264
458 (iota 20)
459
460 ;; Make sure that, when the cutoff is reached, 'map/accumulate-builds' still
461 ;; returns the right result and calls the build handler by batches.
462 (let* ((b (add-text-to-store %store "build" "echo $foo > $out" '()))
463 (s (add-to-store %store "bash" #t "sha256"
464 (search-bootstrap-binary "bash"
465 (%current-system))))
466 (d (map (lambda (i)
467 (derivation %store (string-append "the-thing-"
468 (number->string i))
469 s `("-e" ,b)
470 #:env-vars `(("foo" . ,(random-text)))
471 #:sources (list b s)
472 #:properties `((n . ,i))))
473 (iota 20)))
474 (calls '()))
475 (define lst
476 (with-build-handler (lambda (continue store things mode)
477 (set! calls (cons things calls))
478 (continue #f))
479 (map/accumulate-builds %store
480 (lambda (d)
481 (build-derivations %store (list d))
482 (assq-ref (derivation-properties d) 'n))
483 d
484 #:cutoff 7)))
485
486 (match (reverse calls)
487 (((batch1 ...) (batch2 ...) (batch3 ...))
488 (and (equal? (map derivation-file-name (take d 8)) batch1)
489 (equal? (map derivation-file-name (take (drop d 8) 8)) batch2)
490 (equal? (map derivation-file-name (drop d 16)) batch3)
491 lst)))))
492
457(test-assert "mapm/accumulate-builds" 493(test-assert "mapm/accumulate-builds"
458 (let* ((d1 (run-with-store %store 494 (let* ((d1 (run-with-store %store
459 (gexp->derivation "foo" #~(mkdir #$output)))) 495 (gexp->derivation "foo" #~(mkdir #$output))))