summaryrefslogtreecommitdiff
path: root/tests/graph.scm
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2015-11-21 14:48:34 +0100
committerLudovic Courtès <ludo@gnu.org>2015-11-21 16:26:43 +0100
commit923d846c4dfe0f51357d3329697f54c779148dde (patch)
tree7a976f7d38f241d285d005881f17133e9032751b /tests/graph.scm
parent8fb583714f78d1b283523ef7edbb6e098946182f (diff)
downloadpatches-923d846c4dfe0f51357d3329697f54c779148dde.tar
patches-923d846c4dfe0f51357d3329697f54c779148dde.tar.gz
graph: Add procedures to query a node's edges.
* guix/graph.scm (%node-edges, node-edges, node-back-edges) (node-transitive-edges): New procedures. * tests/graph.scm ("node-edges") ("node-transitive-edges + node-back-edges"): New tests.
Diffstat (limited to 'tests/graph.scm')
-rw-r--r--tests/graph.scm38
1 files changed, 37 insertions, 1 deletions
diff --git a/tests/graph.scm b/tests/graph.scm
index ed5849f4da..9c9e3666b7 100644
--- a/tests/graph.scm
+++ b/tests/graph.scm
@@ -25,8 +25,12 @@
#:use-module (guix store)
#:use-module (guix monads)
#:use-module (guix build-system gnu)
+ #:use-module (guix build-system trivial)
#:use-module (guix gexp)
+ #:use-module (guix utils)
#:use-module (gnu packages)
+ #:use-module (gnu packages base)
+ #:use-module (gnu packages guile)
#:use-module (gnu packages bootstrap)
#:use-module (ice-9 match)
#:use-module (srfi srfi-1)
@@ -111,7 +115,7 @@ edges."
".drv")))
implicit)))))))
-(test-assert "bag DAG"
+(test-assert "bag DAG" ;a big town in Iraq
(let-values (((backend nodes+edges) (make-recording-backend)))
(let ((p (dummy-package "p")))
(run-with-store %store
@@ -188,6 +192,38 @@ edges."
(list out txt))
(equal? edges `((,out ,txt)))))))))))
+(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 grep))
+ (lset= eq?
+ (edges guile-2.0)
+ (match (package-direct-inputs guile-2.0)
+ (((labels packages _ ...) ...)
+ packages)))))))))
+
+(test-assert "node-transitive-edges + node-back-edges"
+ (run-with-store %store
+ (let ((packages (fold-packages cons '()))
+ (bootstrap? (lambda (package)
+ (string-contains
+ (location-file (package-location package))
+ "bootstrap.scm")))
+ (trivial? (lambda (package)
+ (eq? (package-build-system package)
+ trivial-build-system))))
+ (mlet %store-monad ((edges (node-back-edges %bag-node-type packages)))
+ (let* ((glibc (canonical-package glibc))
+ (dependents (node-transitive-edges (list glibc) edges))
+ (diff (lset-difference eq? packages dependents)))
+ ;; All the packages depend on libc, except bootstrap packages and
+ ;; some that use TRIVIAL-BUILD-SYSTEM.
+ (return (null? (remove (lambda (package)
+ (or (trivial? package)
+ (bootstrap? package)))
+ diff))))))))
+
(test-end "graph")