diff options
| author | Ludovic Courtès <ludo@gnu.org> | 2015-11-21 14:48:34 +0100 |
|---|---|---|
| committer | Ludovic Courtès <ludo@gnu.org> | 2015-11-21 16:26:43 +0100 |
| commit | 923d846c4dfe0f51357d3329697f54c779148dde (patch) | |
| tree | 7a976f7d38f241d285d005881f17133e9032751b /tests/graph.scm | |
| parent | 8fb583714f78d1b283523ef7edbb6e098946182f (diff) | |
| download | gnu-guix-923d846c4dfe0f51357d3329697f54c779148dde.tar gnu-guix-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.scm | 38 |
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") |