diff options
| author | Ludovic Courtès <ludo@gnu.org> | 2021-09-15 16:23:48 +0200 |
|---|---|---|
| committer | Ludovic Courtès <ludo@gnu.org> | 2021-09-15 16:52:13 +0200 |
| commit | f72f4b48c6777da9465ab17baa6762476d6cb270 (patch) | |
| tree | 0f38dcacc02a9e5b3e37b3aeb85aceedef1ecf40 /tests | |
| parent | a840caccaee8c9492f4cc8a7ba802ef54391f199 (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.scm | 36 |
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)))) |
