diff options
author | Ludovic Courtès <ludo@gnu.org> | 2020-05-10 00:04:59 +0200 |
---|---|---|
committer | Ludovic Courtès <ludo@gnu.org> | 2020-05-11 23:30:55 +0200 |
commit | 724020213664239ec5c92d04f5fee44c25408a7f (patch) | |
tree | f1c6d4c48b8be527b5900ab15a3e60bca2833980 /tests | |
parent | c2b2c19a7b8b75ef6dd153ca121dd8765cdcd746 (diff) | |
download | guix-724020213664239ec5c92d04f5fee44c25408a7f.tar.gz |
graph: reference/referrer node types work with graph traversal.
The graph traversal procedures in (guix graph) assume that nodes can be compared with 'eq?', which was not the case for nodes of %REFERENCE-NODE-TYPE and %REFERRER-NODE-TYPE (strings). * guix/scripts/graph.scm (intern): New procedure. (ensure-store-items, references*) (%reference-node-type, non-derivation-referrers) (%referrer-node-type): Use it on all store items. * tests/graph.scm ("node-transitive-edges, references"): New test.
Diffstat (limited to 'tests')
-rw-r--r-- | tests/graph.scm | 27 |
1 files changed, 27 insertions, 0 deletions
diff --git a/tests/graph.scm b/tests/graph.scm index 402847102f..983a6ed654 100644 --- a/tests/graph.scm +++ b/tests/graph.scm @@ -31,6 +31,7 @@ #:use-module (guix utils) #:use-module (gnu packages) #:use-module (gnu packages base) + #:use-module (gnu packages bootstrap) #:use-module (gnu packages guile) #:use-module (gnu packages libunistring) #:use-module (gnu packages bootstrap) @@ -358,6 +359,32 @@ edges." (return (lset= eq? (node-transitive-edges (list p2) edges) (list p1a p1b p0))))))) +(test-assert "node-transitive-edges, references" + (run-with-store %store + (mlet* %store-monad ((d0 (package->derivation %bootstrap-guile)) + (d1 (gexp->derivation "d1" + #~(begin + (mkdir #$output) + (symlink #$%bootstrap-guile + (string-append + #$output "/l"))))) + (d2 (gexp->derivation "d2" + #~(begin + (mkdir #$output) + (symlink #$d1 + (string-append + #$output "/l"))))) + (_ (built-derivations (list d2))) + (->node -> (node-type-convert %reference-node-type)) + (o2 (->node (derivation->output-path d2))) + (o1 (->node (derivation->output-path d1))) + (o0 (->node (derivation->output-path d0))) + (edges (node-edges %reference-node-type + (append o0 o1 o2))) + (reqs ((store-lift requisites) o2))) + (return (lset= string=? + (append o2 (node-transitive-edges o2 edges)) reqs))))) + (test-equal "node-reachable-count" '(3 3) (run-with-store %store |