1
0
mirror of https://git.savannah.gnu.org/git/guix.git synced 2026-04-06 13:10:33 +02:00

graph: Add '%referrer-node-type'.

* guix/scripts/graph.scm (ensure-store-items): New procedure.
(%reference-node-type)[convert]: Use it.
(non-derivation-referrers): New procedure.
(%referrer-node-type): New variable.
(%node-types): Add it.
* tests/graph.scm ("referrer DAG"): New test.
* doc/guix.texi (Invoking guix graph): Document it.
This commit is contained in:
Ludovic Courtès
2016-10-15 22:47:42 +02:00
parent 783ae212c2
commit 7f8fec0fa4
3 changed files with 74 additions and 15 deletions

View File

@@ -232,6 +232,28 @@ edges."
(list out txt))
(equal? edges `((,out ,txt)))))))))))
(test-assert "referrer DAG"
(let-values (((backend nodes+edges) (make-recording-backend)))
(run-with-store %store
(mlet* %store-monad ((txt (text-file "referrer-node" (random-text)))
(drv (gexp->derivation "referrer"
#~(symlink #$txt #$output)))
(out -> (derivation->output-path drv)))
;; We should see only TXT and OUT, with an edge from the former to the
;; latter.
(mbegin %store-monad
(built-derivations (list drv))
(export-graph (list txt) 'port
#:node-type %referrer-node-type
#:backend backend)
(let-values (((nodes edges) (nodes+edges)))
(return
(and (equal? (match nodes
(((ids labels) ...)
ids))
(list txt out))
(equal? edges `((,txt ,out)))))))))))
(test-assert "node-edges"
(run-with-store %store
(let ((packages (fold-packages cons '())))