mirror of
https://git.in.rschanz.org/ryan77627/guix.git
synced 2024-12-24 21:38:07 -05:00
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
2 changed files with 53 additions and 1 deletions
|
@ -66,6 +66,10 @@ (define-module (guix store)
|
||||||
substitutable-paths
|
substitutable-paths
|
||||||
substitutable-path-info
|
substitutable-path-info
|
||||||
|
|
||||||
|
references
|
||||||
|
referrers
|
||||||
|
valid-derivers
|
||||||
|
query-derivation-outputs
|
||||||
live-paths
|
live-paths
|
||||||
dead-paths
|
dead-paths
|
||||||
collect-garbage
|
collect-garbage
|
||||||
|
@ -126,7 +130,8 @@ (define-enumerate-type operation-id
|
||||||
(query-path-from-hash-part 29)
|
(query-path-from-hash-part 29)
|
||||||
(query-substitutable-path-infos 30)
|
(query-substitutable-path-infos 30)
|
||||||
(query-valid-paths 31)
|
(query-valid-paths 31)
|
||||||
(query-substitutable-paths 32))
|
(query-substitutable-paths 32)
|
||||||
|
(query-valid-derivers 33))
|
||||||
|
|
||||||
(define-enumerate-type hash-algo
|
(define-enumerate-type hash-algo
|
||||||
;; hash.hh
|
;; hash.hh
|
||||||
|
@ -597,6 +602,27 @@ (define-operation (add-indirect-root (string file-name))
|
||||||
file name. Return #t on success."
|
file name. Return #t on success."
|
||||||
boolean)
|
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))
|
(define-operation (has-substitutes? (store-path path))
|
||||||
"Return #t if binary substitutes are available for PATH, and #f otherwise."
|
"Return #t if binary substitutes are available for PATH, and #f otherwise."
|
||||||
boolean)
|
boolean)
|
||||||
|
|
|
@ -23,6 +23,7 @@ (define-module (test-store)
|
||||||
#:use-module (guix base32)
|
#:use-module (guix base32)
|
||||||
#:use-module (guix packages)
|
#:use-module (guix packages)
|
||||||
#:use-module (guix derivations)
|
#:use-module (guix derivations)
|
||||||
|
#:use-module (gnu packages)
|
||||||
#:use-module (gnu packages bootstrap)
|
#:use-module (gnu packages bootstrap)
|
||||||
#:use-module (ice-9 match)
|
#:use-module (ice-9 match)
|
||||||
#:use-module (srfi srfi-1)
|
#:use-module (srfi srfi-1)
|
||||||
|
@ -79,6 +80,31 @@ (define (random-text)
|
||||||
(> freed 0)
|
(> freed 0)
|
||||||
(not (file-exists? p))))))
|
(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"
|
(test-assert "no substitutes"
|
||||||
(let* ((s (open-connection))
|
(let* ((s (open-connection))
|
||||||
(d1 (package-derivation s %bootstrap-guile (%current-system)))
|
(d1 (package-derivation s %bootstrap-guile (%current-system)))
|
||||||
|
|
Loading…
Reference in a new issue