store: Add queries for references & co.

* guix/store.scm (operation-id)[query-valid-derivers]: New value.
  (references, referrers, valid-derivers, query-derivation-outputs): New
  procedures.
* tests/store.scm ("references", "derivers"): New tests.
This commit is contained in:
Ludovic Courtès 2013-02-27 22:40:35 +01:00
parent 149acc2981
commit fae31edcec
2 changed files with 53 additions and 1 deletions

@ -66,6 +66,10 @@
substitutable-paths
substitutable-path-info
references
referrers
valid-derivers
query-derivation-outputs
live-paths
dead-paths
collect-garbage
@ -126,7 +130,8 @@
(query-path-from-hash-part 29)
(query-substitutable-path-infos 30)
(query-valid-paths 31)
(query-substitutable-paths 32))
(query-substitutable-paths 32)
(query-valid-derivers 33))
(define-enumerate-type hash-algo
;; hash.hh
@ -597,6 +602,27 @@ name--it is the caller's responsibility to ensure that it is an absolute
file name. Return #t on success."
boolean)
(define references
(operation (query-references (store-path path))
"Return the list of references of PATH."
store-path-list))
(define referrers
(operation (query-referrers (store-path path))
"Return the list of path that refer to PATH."
store-path-list))
(define valid-derivers
(operation (query-valid-derivers (store-path path))
"Return the list of valid \"derivers\" of PATH---i.e., all the
.drv present in the store that have PATH among their outputs."
store-path-list))
(define query-derivation-outputs ; avoid name clash with `derivation-outputs'
(operation (query-derivation-outputs (store-path path))
"Return the list of outputs of PATH, a .drv file."
store-path-list))
(define-operation (has-substitutes? (store-path path))
"Return #t if binary substitutes are available for PATH, and #f otherwise."
boolean)

@ -23,6 +23,7 @@
#:use-module (guix base32)
#:use-module (guix packages)
#:use-module (guix derivations)
#:use-module (gnu packages)
#:use-module (gnu packages bootstrap)
#:use-module (ice-9 match)
#:use-module (srfi srfi-1)
@ -79,6 +80,31 @@
(> freed 0)
(not (file-exists? p))))))
(test-assert "references"
(let* ((t1 (add-text-to-store %store "random1"
(random-text) '()))
(t2 (add-text-to-store %store "random2"
(random-text) (list t1))))
(and (equal? (list t1) (references %store t2))
(equal? (list t2) (referrers %store t1))
(null? (references %store t1))
(null? (referrers %store t2)))))
(test-assert "derivers"
(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))))
(d (derivation %store "the-thing" (%current-system)
s `("-e" ,b) `(("foo" . ,(random-text)))
`((,b) (,s))))
(o (derivation-path->output-path d)))
(and (build-derivations %store (list d))
(equal? (query-derivation-outputs %store d)
(list o))
(equal? (valid-derivers %store o)
(list d)))))
(test-assert "no substitutes"
(let* ((s (open-connection))
(d1 (package-derivation s %bootstrap-guile (%current-system)))