From 7f8fec0fa40951de33822f86c31c32e3f3c5513e Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Sat, 15 Oct 2016 22:47:42 +0200 Subject: 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. --- tests/graph.scm | 22 ++++++++++++++++++++++ 1 file changed, 22 insertions(+) (limited to 'tests/graph.scm') diff --git a/tests/graph.scm b/tests/graph.scm index 1ce06cc817..f2e441cee6 100644 --- a/tests/graph.scm +++ b/tests/graph.scm @@ -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 '()))) -- cgit v1.2.3