01/02: graph: %BAG-EMERGED-NODE-TYPE filters out origins.

[Ludovic Courtès]

civodul pushed a commit to branch master
in repository guix.

commit f88282af38dfe805034686e88bab734c582ef74d
Author: Ludovic Courtès <address@hidden>
Date:   Sat Jan 2 22:12:36 2016 +0100

    graph: %BAG-EMERGED-NODE-TYPE filters out origins.
    
    Fixes <http://bugs.gnu.org/22280>.
    Reported by Leo Famulari <address@hidden>.
    
    * guix/scripts/graph.scm (%bag-emerged-node-type)[edges]: Mimic
    %BAG-NODE-TYPE.  This is a followup to 38b92da.
---
 guix/scripts/graph.scm |    6 ++++--
 tests/graph.scm        |   14 ++++++++------
 2 files changed, 12 insertions(+), 8 deletions(-)

diff --git a/guix/scripts/graph.scm b/guix/scripts/graph.scm
index 9255f00..9d9eb22 100644
--- a/guix/scripts/graph.scm
+++ b/guix/scripts/graph.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2015 Ludovic Courtès <address@hidden>
+;;; Copyright © 2015, 2016 Ludovic Courtès <address@hidden>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -171,7 +171,9 @@ GNU-BUILD-SYSTEM have zero dependencies."
    (description "same as 'bag', but without the bootstrap nodes")
    (identifier bag-node-identifier)
    (label node-full-name)
-   (edges (lift1 bag-node-edges-sans-bootstrap %store-monad))))
+   (edges (lift1 (compose (cut filter package? <>)
+                          bag-node-edges-sans-bootstrap)
+                 %store-monad))))
 
 
 ;;;
diff --git a/tests/graph.scm b/tests/graph.scm
index 04c6e74..daf64dc 100644
--- a/tests/graph.scm
+++ b/tests/graph.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2015 Ludovic Courtès <address@hidden>
+;;; Copyright © 2015, 2016 Ludovic Courtès <address@hidden>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -89,16 +89,18 @@ edges."
 
 (test-assert "bag-emerged DAG"
   (let-values (((backend nodes+edges) (make-recording-backend)))
-    (let ((p        (dummy-package "p"))
-          (implicit (map (match-lambda
-                           ((label package) package))
-                         (standard-packages))))
+    (let* ((o        (dummy-origin (method (lambda _
+                                             (text-file "foo" "bar")))))
+           (p        (dummy-package "p" (source o)))
+           (implicit (map (match-lambda
+                            ((label package) 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.
+      ;; element of IMPLICIT.  O must not appear among NODES.
       (let-values (((nodes edges) (nodes+edges)))
         (and (equal? (match nodes
                        (((labels names) ...)