ryan77627/guix
1
0
Fork 0
mirror of https://git.in.rschanz.org/ryan77627/guix.git synced 2024-12-25 13:58:15 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

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

Browse source 
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.
This commit is contained in:
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 ;;; 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. ;;; This file is part of GNU Guix.
;;; ;;;
@ -171,7 +171,9 @@ (define %bag-emerged-node-type
(description "same as 'bag', but without the bootstrap nodes") (description "same as 'bag', but without the bootstrap nodes")
(identifier bag-node-identifier) (identifier bag-node-identifier)
(label node-full-name) (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 ;;; 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. ;;; This file is part of GNU Guix.
;;; ;;;
@ -89,16 +89,18 @@ (define (edge->tuple source target)
(test-assert "bag-emerged DAG" (test-assert "bag-emerged DAG"
(let-values (((backend nodes+edges) (make-recording-backend))) (let-values (((backend nodes+edges) (make-recording-backend)))
(let ((p (dummy-package "p")) (let* ((o (dummy-origin (method (lambda _
(implicit (map (match-lambda (text-file "foo" "bar")))))
((label package) package)) (p (dummy-package "p" (source o)))
(standard-packages)))) (implicit (map (match-lambda
((label package) package))
(standard-packages))))
(run-with-store %store (run-with-store %store
(export-graph (list p) 'port (export-graph (list p) 'port
#:node-type %bag-emerged-node-type #:node-type %bag-emerged-node-type
#:backend backend)) #:backend backend))
;; We should see exactly P and IMPLICIT, with one edge from P to each ;; 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))) (let-values (((nodes edges) (nodes+edges)))
(and (equal? (match nodes (and (equal? (match nodes
(((labels names) ...) (((labels names) ...)