summary refs log tree commit diff
path: root/tests
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2016-10-15 22:47:42 +0200
committerLudovic Courtès <ludo@gnu.org>2016-10-15 23:46:39 +0200
commit7f8fec0fa40951de33822f86c31c32e3f3c5513e (patch)
tree2e3ebc7b65649ae26279cfbaeac97878cbbc33f1 /tests
parent783ae212c213d6194ecbbdb13b91d93a6644a1ac (diff)
downloadguix-7f8fec0fa40951de33822f86c31c32e3f3c5513e.tar.gz
graph: Add '%referrer-node-type'.
* guix/scripts/graph.scm (ensure-store-items): New procedure.
(%reference-node-type)[convert]: Use it.
(non-derivation-referrers): New procedure.
(%referrer-node-type): New variable.
(%node-types): Add it.
* tests/graph.scm ("referrer DAG"): New test.
* doc/guix.texi (Invoking guix graph): Document it.
Diffstat (limited to 'tests')
-rw-r--r--tests/graph.scm22
1 files changed, 22 insertions, 0 deletions
diff --git a/tests/graph.scm b/tests/graph.scm
index 1ce06cc817..f2e441cee6 100644
--- a/tests/graph.scm
+++ b/tests/graph.scm
@@ -232,6 +232,28 @@ edges."
                           (list out txt))
                   (equal? edges `((,out ,txt)))))))))))
 
+(test-assert "referrer DAG"
+  (let-values (((backend nodes+edges) (make-recording-backend)))
+    (run-with-store %store
+      (mlet* %store-monad ((txt   (text-file "referrer-node" (random-text)))
+                           (drv   (gexp->derivation "referrer"
+                                                    #~(symlink #$txt #$output)))
+                           (out -> (derivation->output-path drv)))
+        ;; We should see only TXT and OUT, with an edge from the former to the
+        ;; latter.
+        (mbegin %store-monad
+          (built-derivations (list drv))
+          (export-graph (list txt) 'port
+                        #:node-type %referrer-node-type
+                        #:backend backend)
+          (let-values (((nodes edges) (nodes+edges)))
+            (return
+             (and (equal? (match nodes
+                            (((ids labels) ...)
+                             ids))
+                          (list txt out))
+                  (equal? edges `((,txt ,out)))))))))))
+
 (test-assert "node-edges"
   (run-with-store %store
     (let ((packages (fold-packages cons '())))