nixo
/
guix-devel
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

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.
master
Ludovic Courtès 2016-01-02 22:12:36 +01:00
parent 1ae858f333
commit f88282af38
2 changed files with 12 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
guix/scripts/graph.scm
View File

@ -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))))
;;;

14
tests/graph.scm
View File

@ -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) ...)