From 724020213664239ec5c92d04f5fee44c25408a7f Mon Sep 17 00:00:00 2001
From: Ludovic Courtès <ludo@gnu.org>
Date: Sun, 10 May 2020 00:04:59 +0200
Subject: 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.
---
 tests/graph.scm | 27 +++++++++++++++++++++++++++
 1 file changed, 27 insertions(+)

(limited to 'tests')

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
-- 
cgit v1.2.3