ryan77627/guix
1
0
Fork 0
mirror of https://git.in.rschanz.org/ryan77627/guix.git synced 2025-01-24 11:39:46 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

graph: %BAG-WITH-ORIGINS-NODE-TYPE includes the origin's guile.

Browse source 
Before that it would include #f for most origins since that the default
value of 'origin-patch-guile'.

* guix/scripts/graph.scm (bag-node-edges): When 'origin-patch-guile'
returns #f, use (default-guile).
* tests/graph.scm ("bag DAG, including origins"): Check for an edge from
O to (default-guile).
This commit is contained in:
Ludovic Courtès 2016-01-02 22:22:57 +01:00
parent f88282af38
commit 51385362f7
2 changed files with 10 additions and 2 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

2
guix/scripts/graph.scm
View file

@ -113,7 +113,7 @@ (define (bag-node-edges thing)
(((labels things . outputs) ...)
things)))
((origin? thing)
(cons (origin-patch-guile thing)
(cons (or (origin-patch-guile thing) (default-guile))
(if (or (pair? (origin-patches thing))
(origin-snippet thing))
(match (origin-patch-inputs thing)

10
tests/graph.scm
View file

@ -150,7 +150,8 @@ (define (edge->tuple source target)
(let-values (((nodes edges) (nodes+edges)))
(run-with-store %store
(mlet %store-monad ((o* (lower-object o))
(p* (lower-object p)))
(p* (lower-object p))
(g (lower-object (default-guile))))
(return
(and (find (match-lambda
((file "the-uri") #t)
@ -160,6 +161,13 @@ (define (edge->tuple source target)
((source target)
(and (string=? source (derivation-file-name p*))
(string=? target o*))))
edges)
;; There must also be an edge from O to G.
(find (match-lambda
((source target)
(and (string=? source o*)
(string=? target (derivation-file-name g)))))
edges)))))))))
(test-assert "derivation DAG"