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:
parent
149acc2981
commit
fae31edcec
@ -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)))
|
||||
|
Loading…
Reference in New Issue
Block a user