summary refs log tree commit diff
path: root/tests/graph.scm
diff options
context:
space:
mode:
Diffstat (limited to 'tests/graph.scm')
-rw-r--r--tests/graph.scm35
1 files changed, 28 insertions, 7 deletions
diff --git a/tests/graph.scm b/tests/graph.scm
index ad8aea0ada..4f85432d2f 100644
--- a/tests/graph.scm
+++ b/tests/graph.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2015 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2015, 2016 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -89,16 +89,18 @@ edges."
 
 (test-assert "bag-emerged DAG"
   (let-values (((backend nodes+edges) (make-recording-backend)))
-    (let ((p        (dummy-package "p"))
-          (implicit (map (match-lambda
-                           ((label package) package))
-                         (standard-packages))))
+    (let* ((o        (dummy-origin (method (lambda _
+                                             (text-file "foo" "bar")))))
+           (p        (dummy-package "p" (source o)))
+           (implicit (map (match-lambda
+                            ((label package) package))
+                          (standard-packages))))
       (run-with-store %store
         (export-graph (list p) 'port
                       #:node-type %bag-emerged-node-type
                       #:backend backend))
       ;; We should see exactly P and IMPLICIT, with one edge from P to each
-      ;; element of IMPLICIT.
+      ;; element of IMPLICIT.  O must not appear among NODES.
       (let-values (((nodes edges) (nodes+edges)))
         (and (equal? (match nodes
                        (((labels names) ...)
@@ -148,7 +150,8 @@ edges."
       (let-values (((nodes edges) (nodes+edges)))
         (run-with-store %store
           (mlet %store-monad ((o* (lower-object o))
-                              (p* (lower-object p)))
+                              (p* (lower-object p))
+                              (g  (lower-object (default-guile))))
             (return
              (and (find (match-lambda
                           ((file "the-uri") #t)
@@ -158,6 +161,13 @@ edges."
                           ((source target)
                            (and (string=? source (derivation-file-name p*))
                                 (string=? target o*))))
+                        edges)
+
+                  ;; There must also be an edge from O to G.
+                  (find (match-lambda
+                          ((source target)
+                           (and (string=? source o*)
+                                (string=? target (derivation-file-name g)))))
                         edges)))))))))
 
 (test-assert "derivation DAG"
@@ -250,6 +260,17 @@ edges."
                                        (bootstrap? package)))
                                  diff))))))))
 
+(test-assert "node-transitive-edges, no duplicates"
+  (run-with-store %store
+    (let* ((p0  (dummy-package "p0"))
+           (p1a (dummy-package "p1a" (inputs `(("p0" ,p0)))))
+           (p1b (dummy-package "p1b" (inputs `(("p0" ,p0)))))
+           (p2  (dummy-package "p2" (inputs `(("p1a" ,p1a) ("p1b" ,p1b))))))
+      (mlet %store-monad ((edges (node-edges %package-node-type
+                                             (list p2 p1a p1b p0))))
+        (return (lset= eq? (node-transitive-edges (list p2) edges)
+                       (list p1a p1b p0)))))))
+
 (test-end "graph")