tribes/guix
1
0
Fork 0
mirror of https://git.savannah.gnu.org/git/guix.git synced 2026-04-06 21:20:33 +02:00
Code Activity

graph: Add 'shortest-path'.

Browse Source 
* guix/graph.scm (shortest-path): New procedure.
* tests/graph.scm ("shortest-path, packages + derivations")
("shortest-path, reverse packages")
("shortest-path, references"): New tests.
This commit is contained in:
Ludovic Courtès
2020-05-10 00:09:05 +02:00
parent 7240202136
commit 36c2192414
2 changed files with 129 additions and 1 deletions
Download Patch File Download Diff File Expand all files Collapse all files

61
tests/graph.scm
View File

@@ -398,4 +398,65 @@ edges."
(return (list (node-reachable-count (list p2) edges)
(node-reachable-count (list p0) back)))))))
(test-equal "shortest-path, packages + derivations"
'(("p5" "p4" "p1" "p0")
("p3" "p2" "p1" "p0")
#f
("p5-0.drv" "p4-0.drv" "p1-0.drv" "p0-0.drv"))
(run-with-store %store
(let* ((p0 (dummy-package "p0"))
(p1 (dummy-package "p1" (inputs `(("p0" ,p0)))))
(p2 (dummy-package "p2" (inputs `(("p1" ,p1)))))
(p3 (dummy-package "p3" (inputs `(("p2" ,p2)))))
(p4 (dummy-package "p4" (inputs `(("p1" ,p1)))))
(p5 (dummy-package "p5" (inputs `(("p4" ,p4) ("p3" ,p3))))))
(mlet* %store-monad ((path1 (shortest-path p5 p0 %package-node-type))
(path2 (shortest-path p3 p0 %package-node-type))
(nope (shortest-path p3 p4 %package-node-type))
(drv5 (package->derivation p5))
(drv0 (package->derivation p0))
(path3 (shortest-path drv5 drv0
%derivation-node-type)))
(return (append (map (lambda (path)
(and path (map package-name path)))
(list path1 path2 nope))
(list (map (node-type-label %derivation-node-type)
path3))))))))
(test-equal "shortest-path, reverse packages"
'("libffi" "guile" "guile-json")
(run-with-store %store
(mlet %store-monad ((path (shortest-path (specification->package "libffi")
guile-json
%reverse-package-node-type)))
(return (map package-name path)))))
(test-equal "shortest-path, references"
`(("d2" "d1" ,(package-full-name %bootstrap-guile "-"))
(,(package-full-name %bootstrap-guile "-") "d1" "d2"))
(run-with-store %store
(mlet* %store-monad ((d0 (package->derivation %bootstrap-guile))
(d1 (gexp->derivation "d1"
#~(begin
(mkdir #$output)
(symlink #$%bootstrap-guile
(string-append
#$output "/l")))))
(d2 (gexp->derivation "d2"
#~(begin
(mkdir #$output)
(symlink #$d1
(string-append
#$output "/l")))))
(_ (built-derivations (list d2)))
(->node -> (node-type-convert %reference-node-type))
(o2 (->node (derivation->output-path d2)))
(o0 (->node (derivation->output-path d0)))
(path (shortest-path (first o2) (first o0)
%reference-node-type))
(rpath (shortest-path (first o0) (first o2)
%referrer-node-type)))
(return (list (map (node-type-label %reference-node-type) path)
(map (node-type-label %referrer-node-type) rpath))))))
(test-end "graph")