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

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
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 @@ Dependencies may include packages, origin, and file names."
(((labels things . outputs) ...) (((labels things . outputs) ...)
things))) things)))
((origin? thing) ((origin? thing)
(cons (origin-patch-guile thing) (cons (or (origin-patch-guile thing) (default-guile))
(if (or (pair? (origin-patches thing)) (if (or (pair? (origin-patches thing))
(origin-snippet thing)) (origin-snippet thing))
(match (origin-patch-inputs thing) (match (origin-patch-inputs thing)

10
tests/graph.scm
View File

@ -150,7 +150,8 @@ edges."
(let-values (((nodes edges) (nodes+edges))) (let-values (((nodes edges) (nodes+edges)))
(run-with-store %store (run-with-store %store
(mlet %store-monad ((o* (lower-object o)) (mlet %store-monad ((o* (lower-object o))
(p* (lower-object p))) (p* (lower-object p))
(g (lower-object (default-guile))))
(return (return
(and (find (match-lambda (and (find (match-lambda
((file "the-uri") #t) ((file "the-uri") #t)
@ -160,6 +161,13 @@ edges."
((source target) ((source target)
(and (string=? source (derivation-file-name p*)) (and (string=? source (derivation-file-name p*))
(string=? target o*)))) (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))))))))) edges)))))))))
(test-assert "derivation DAG" (test-assert "derivation DAG"