1
0
mirror of https://git.savannah.gnu.org/git/guix.git synced 2026-04-06 21:20:33 +02:00

store: Add 'map/accumulate-builds'.

* guix/store.scm (<unresolved>): New record type.
(build-accumulator, map/accumulate-builds, mapm/accumulate-builds): New
procedures.
* tests/store.scm ("map/accumulate-builds", "mapm/accumulate-builds"):
New tests.
This commit is contained in:
Ludovic Courtès
2020-03-25 12:41:18 +01:00
parent 3b1886c9dd
commit c40bf5816c
2 changed files with 92 additions and 0 deletions

View File

@@ -412,6 +412,42 @@
(build-derivations %store (list d2))
'fail)))
(test-assert "map/accumulate-builds"
(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))))
(d1 (derivation %store "the-thing"
s `("-e" ,b)
#:env-vars `(("foo" . ,(random-text)))
#:sources (list b s)))
(d2 (derivation %store "the-thing"
s `("-e" ,b)
#:env-vars `(("foo" . ,(random-text))
("bar" . "baz"))
#:sources (list b s))))
(with-build-handler (lambda (continue store things mode)
(equal? (map derivation-file-name (list d1 d2))
things))
(map/accumulate-builds %store
(lambda (drv)
(build-derivations %store (list drv))
(add-to-store %store "content-addressed"
#t "sha256"
(derivation->output-path drv)))
(list d1 d2)))))
(test-assert "mapm/accumulate-builds"
(let* ((d1 (run-with-store %store
(gexp->derivation "foo" #~(mkdir #$output))))
(d2 (run-with-store %store
(gexp->derivation "bar" #~(mkdir #$output)))))
(with-build-handler (lambda (continue store things mode)
(equal? (map derivation-file-name (pk 'zz (list d1 d2)))
(pk 'XX things)))
(run-with-store %store
(mapm/accumulate-builds built-derivations `((,d1) (,d2)))))))
(test-assert "topologically-sorted, one item"
(let* ((a (add-text-to-store %store "a" "a"))
(b (add-text-to-store %store "b" "b" (list a)))