store: Add `requisites'.

* guix/store.scm (fold-path, requisites): New procedures.
* tests/store.scm ("requisites"): New test.
This commit is contained in:
Ludovic Courtès 2013-06-13 22:03:42 +02:00
parent d4c7486079
commit 3f1e69395c
2 changed files with 44 additions and 0 deletions

View File

@ -31,6 +31,7 @@
#:use-module (srfi srfi-39) #:use-module (srfi srfi-39)
#:use-module (ice-9 match) #:use-module (ice-9 match)
#:use-module (ice-9 regex) #:use-module (ice-9 regex)
#:use-module (ice-9 vlist)
#:export (%daemon-socket-file #:export (%daemon-socket-file
nix-server? nix-server?
@ -70,6 +71,7 @@
substitutable-path-info substitutable-path-info
references references
requisites
referrers referrers
valid-derivers valid-derivers
query-derivation-outputs query-derivation-outputs
@ -493,6 +495,30 @@ file name. Return #t on success."
"Return the list of references of PATH." "Return the list of references of PATH."
store-path-list)) 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 (define referrers
(operation (query-referrers (store-path path)) (operation (query-referrers (store-path path))
"Return the list of path that refer to PATH." "Return the list of path that refer to PATH."

View File

@ -106,6 +106,24 @@
(null? (references %store t1)) (null? (references %store t1))
(null? (referrers %store t2))))) (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" (test-assert "derivers"
(let* ((b (add-text-to-store %store "build" "echo $foo > $out" '())) (let* ((b (add-text-to-store %store "build" "echo $foo > $out" '()))
(s (add-to-store %store "bash" #t "sha256" (s (add-to-store %store "bash" #t "sha256"