summary refs log tree commit diff
path: root/tests/graph.scm
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2015-11-23 23:31:53 +0100
committerLudovic Courtès <ludo@gnu.org>2015-11-23 23:34:15 +0100
commit38b92daa81d6c5eca77ae0cc3d454da46a64b48a (patch)
treefd0fff0db6096636bd5556b7c481c46ca1e8a5c5 /tests/graph.scm
parent961d0d2d2237baca7bd2099aebee279765bbd257 (diff)
downloadguix-38b92daa81d6c5eca77ae0cc3d454da46a64b48a.tar.gz
graph: Add '%bag-with-origins-node-type'.
* guix/scripts/graph.scm (bag-node-edges): Remove 'filter' call.  Add
case for 'origin'.
(%bag-node-type)[edges]: Add filtering here.
(%bag-with-origins-node-type): New variable.
(%node-types): Add it.
* tests/graph.scm ("bag DAG, including origins"): New test.
* tests/guix-graph.sh: Add 'bag-with-origins'.
* doc/guix.texi (Invoking guix graph): Document it.
Diffstat (limited to 'tests/graph.scm')
-rw-r--r--tests/graph.scm26
1 files changed, 26 insertions, 0 deletions
diff --git a/tests/graph.scm b/tests/graph.scm
index 9c9e3666b7..ad8aea0ada 100644
--- a/tests/graph.scm
+++ b/tests/graph.scm
@@ -134,6 +134,32 @@ edges."
                  (((labels packages) ...)
                   (map package-full-name packages))))))))
 
+(test-assert "bag DAG, including origins"
+  (let-values (((backend nodes+edges) (make-recording-backend)))
+    (let* ((m (lambda* (uri hash-type hash name #:key system)
+                (text-file "foo-1.2.3.tar.gz" "This is a fake!")))
+           (o (origin (method m) (uri "the-uri") (sha256 #vu8(0 1 2))))
+           (p (dummy-package "p" (source o))))
+      (run-with-store %store
+        (export-graph (list p) 'port
+                      #:node-type %bag-with-origins-node-type
+                      #:backend backend))
+      ;; We should see O among the nodes, with an edge coming from P.
+      (let-values (((nodes edges) (nodes+edges)))
+        (run-with-store %store
+          (mlet %store-monad ((o* (lower-object o))
+                              (p* (lower-object p)))
+            (return
+             (and (find (match-lambda
+                          ((file "the-uri") #t)
+                          (_                #f))
+                        nodes)
+                  (find (match-lambda
+                          ((source target)
+                           (and (string=? source (derivation-file-name p*))
+                                (string=? target o*))))
+                        edges)))))))))
+
 (test-assert "derivation DAG"
   (let-values (((backend nodes+edges) (make-recording-backend)))
     (run-with-store %store