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

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

View File

@ -113,7 +113,7 @@ Dependencies may include packages, origin, and file names."
(((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)

View File

@ -150,7 +150,8 @@ edges."
(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 @@ edges."
((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"