diff options
| -rw-r--r-- | guix/store.scm | 28 | ||||
| -rw-r--r-- | tests/store.scm | 26 |
2 files changed, 53 insertions, 1 deletions
diff --git a/guix/store.scm b/guix/store.scm index 3627d5be04..80b36daf93 100644 --- a/guix/store.scm +++ b/guix/store.scm @@ -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) diff --git a/tests/store.scm b/tests/store.scm index c90fd3fed9..c2de99e160 100644 --- a/tests/store.scm +++ b/tests/store.scm @@ -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))) |