~ruther/guix-local

f88282af38dfe805034686e88bab734c582ef74d — Ludovic Courtès 10 years ago 1ae858f
graph: %BAG-EMERGED-NODE-TYPE filters out origins.

Fixes <http://bugs.gnu.org/22280>.
Reported by Leo Famulari <leo@famulari.name>.

* guix/scripts/graph.scm (%bag-emerged-node-type)[edges]: Mimic
%BAG-NODE-TYPE.  This is a followup to 38b92da.
2 files changed, 12 insertions(+), 8 deletions(-)

M guix/scripts/graph.scm
M tests/graph.scm
M guix/scripts/graph.scm => guix/scripts/graph.scm +4 -2
@@ 1,5 1,5 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2015 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2015, 2016 Ludovic Courtès <ludo@gnu.org>
;;;
;;; 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))))


;;;

M tests/graph.scm => tests/graph.scm +8 -6
@@ 1,5 1,5 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2015 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2015, 2016 Ludovic Courtès <ludo@gnu.org>
;;;
;;; 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) ...)