mirror of
git://git.savannah.gnu.org/guix.git
synced 2023-12-14 03:33:07 +01:00
store: Add `requisites'.
* guix/store.scm (fold-path, requisites): New procedures. * tests/store.scm ("requisites"): New test.
This commit is contained in:
parent
d4c7486079
commit
3f1e69395c
2 changed files with 44 additions and 0 deletions
|
@ -31,6 +31,7 @@
|
|||
#:use-module (srfi srfi-39)
|
||||
#:use-module (ice-9 match)
|
||||
#:use-module (ice-9 regex)
|
||||
#:use-module (ice-9 vlist)
|
||||
#:export (%daemon-socket-file
|
||||
|
||||
nix-server?
|
||||
|
@ -70,6 +71,7 @@
|
|||
substitutable-path-info
|
||||
|
||||
references
|
||||
requisites
|
||||
referrers
|
||||
valid-derivers
|
||||
query-derivation-outputs
|
||||
|
@ -493,6 +495,30 @@ file name. Return #t on success."
|
|||
"Return the list of references of PATH."
|
||||
store-path-list))
|
||||
|
||||
(define* (fold-path store proc seed path
|
||||
#:optional (relatives (cut references store <>)))
|
||||
"Call PROC for each of the RELATIVES of PATH, exactly once, and return the
|
||||
result formed from the successive calls to PROC, the first of which is passed
|
||||
SEED."
|
||||
(let loop ((paths (list path))
|
||||
(result seed)
|
||||
(seen vlist-null))
|
||||
(match paths
|
||||
((path rest ...)
|
||||
(if (vhash-assoc path seen)
|
||||
(loop rest result seen)
|
||||
(let ((seen (vhash-cons path #t seen))
|
||||
(rest (append rest (relatives path)))
|
||||
(result (proc path result)))
|
||||
(loop rest result seen))))
|
||||
(()
|
||||
result))))
|
||||
|
||||
(define (requisites store path)
|
||||
"Return the requisites of PATH, including PATH---i.e., its closure (all its
|
||||
references, recursively)."
|
||||
(fold-path store cons '() path))
|
||||
|
||||
(define referrers
|
||||
(operation (query-referrers (store-path path))
|
||||
"Return the list of path that refer to PATH."
|
||||
|
|
|
@ -106,6 +106,24 @@
|
|||
(null? (references %store t1))
|
||||
(null? (referrers %store t2)))))
|
||||
|
||||
(test-assert "requisites"
|
||||
(let* ((t1 (add-text-to-store %store "random1"
|
||||
(random-text) '()))
|
||||
(t2 (add-text-to-store %store "random2"
|
||||
(random-text) (list t1)))
|
||||
(t3 (add-text-to-store %store "random3"
|
||||
(random-text) (list t2)))
|
||||
(t4 (add-text-to-store %store "random4"
|
||||
(random-text) (list t1 t3))))
|
||||
(define (same? x y)
|
||||
(and (= (length x) (length y))
|
||||
(lset= equal? x y)))
|
||||
|
||||
(and (same? (requisites %store t1) (list t1))
|
||||
(same? (requisites %store t2) (list t1 t2))
|
||||
(same? (requisites %store t3) (list t1 t2 t3))
|
||||
(same? (requisites %store t4) (list t1 t2 t3 t4)))))
|
||||
|
||||
(test-assert "derivers"
|
||||
(let* ((b (add-text-to-store %store "build" "echo $foo > $out" '()))
|
||||
(s (add-to-store %store "bash" #t "sha256"
|
||||
|
|
Loading…
Reference in a new issue