From fae31edcec43c93a996a1872c68d1c540af0068f Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= <ludo@gnu.org>
Date: Wed, 27 Feb 2013 22:40:35 +0100
Subject: 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.
---
 tests/store.scm | 26 ++++++++++++++++++++++++++
 1 file changed, 26 insertions(+)

(limited to 'tests/store.scm')

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)))
-- 
cgit v1.2.3