gnu: ntk: Don't use bundled waf.

[jackhill/guix/guix.git] / tests / graph.scm

diff --git a/tests/graph.scm b/tests/graph.scm
index f2e441c..4799d3b 100644 (file)
--- a/tests/graph.scm
+++ b/tests/graph.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2015, 2016 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2015, 2016, 2017, 2018 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -32,6 +32,7 @@
   #:use-module (gnu packages)
   #:use-module (gnu packages base)
   #:use-module (gnu packages guile)
+  #:use-module (gnu packages libunistring)
   #:use-module (gnu packages bootstrap)
   #:use-module (ice-9 match)
   #:use-module (srfi srfi-1)
@@ -57,7 +58,8 @@ edges."
     (define (return)
       (values (reverse nodes) (reverse edges)))
 
-    (values (graph-backend (const #t) (const #t)
+    (values (graph-backend "test" "This is the test backend."
+                           (const #t) (const #t)
                            record-node record-edge)
             return)))
 
@@ -91,25 +93,40 @@ edges."
                           (list p3 p3 p2)
                           (list p2 p1 p1))))))))
 
+(test-assert "reverse package DAG"
+  (let-values (((backend nodes+edges) (make-recording-backend)))
+    (run-with-store %store
+      (export-graph (list libunistring) 'port
+                    #:node-type %reverse-package-node-type
+                    #:backend backend))
+    ;; We should see nothing more than these 3 packages.
+    (let-values (((nodes edges) (nodes+edges)))
+      (and (member (package->tuple guile-2.0) nodes)
+           (->bool (member (edge->tuple libunistring guile-2.0) edges))))))
+
 (test-assert "bag-emerged DAG"
   (let-values (((backend nodes+edges) (make-recording-backend)))
     (let* ((o        (dummy-origin (method (lambda _
                                              (text-file "foo" "bar")))))
            (p        (dummy-package "p" (source o)))
            (implicit (map (match-lambda
-                            ((label package) package))
+                            ((label package) package)
+                            ((label package output) 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.  O must not appear among NODES.
+      ;; element of IMPLICIT.  O must not appear among NODES.  Note: IMPLICIT
+      ;; contains "glibc" twice, once for "out" and a second time for
+      ;; "static", hence the 'delete-duplicates' call below.
       (let-values (((nodes edges) (nodes+edges)))
         (and (equal? (match nodes
                        (((labels names) ...)
                         names))
-                     (map package-full-name (cons p implicit)))
+                     (map package-full-name
+                          (cons p (delete-duplicates implicit))))
              (equal? (match edges
                        (((sources destinations) ...)
                         (zip (map store-path-package-name sources)
@@ -117,7 +134,7 @@ edges."
                      (map (lambda (destination)
                             (list "p-0.drv"
                                   (string-append
-                                   (package-full-name destination)
+                                   (package-full-name destination "-")
                                    ".drv")))
                           implicit)))))))
 
@@ -254,11 +271,29 @@ edges."
                           (list txt out))
                   (equal? edges `((,txt ,out)))))))))))
 
+(test-assert "module graph"
+  (let-values (((backend nodes+edges) (make-recording-backend)))
+    (run-with-store %store
+      (export-graph '((gnu packages guile)) 'port
+                    #:node-type %module-node-type
+                    #:backend backend))
+
+    (let-values (((nodes edges) (nodes+edges)))
+      (and (member '(gnu packages guile)
+                   (match nodes
+                     (((ids labels) ...) ids)))
+           (->bool (and (member (list '(gnu packages guile)
+                                      '(gnu packages libunistring))
+                                edges)
+                        (member (list '(gnu packages guile)
+                                      '(gnu packages bdw-gc))
+                                edges)))))))
+
 (test-assert "node-edges"
   (run-with-store %store
     (let ((packages (fold-packages cons '())))
       (mlet %store-monad ((edges (node-edges %package-node-type packages)))
-        (return (and (null? (edges sed))
+        (return (and (null? (edges hello))
                      (lset= eq?
                             (edges guile-2.0)
                             (match (package-direct-inputs guile-2.0)