diff --git a/guix/store.scm b/guix/store.scm index ede64341c5..eca0de7d97 100644 --- a/guix/store.scm +++ b/guix/store.scm @@ -76,6 +76,7 @@ references requisites referrers + topologically-sorted valid-derivers query-derivation-outputs live-paths @@ -589,6 +590,40 @@ SEED." references, recursively)." (fold-path store cons '() path)) +(define (topologically-sorted store paths) + "Return a list containing PATHS and all their references sorted in +topological order." + (define (traverse) + ;; Do a simple depth-first traversal of all of PATHS. + (let loop ((paths paths) + (visited vlist-null) + (result '())) + (define (visit n) + (vhash-cons n #t visited)) + + (define (visited? n) + (vhash-assoc n visited)) + + (match paths + ((head tail ...) + (if (visited? head) + (loop tail visited result) + (call-with-values + (lambda () + (loop (references store head) + (visit head) + result)) + (lambda (visited result) + (loop tail + visited + (cons head result)))))) + (() + (values visited result))))) + + (call-with-values traverse + (lambda (_ result) + (reverse result)))) + (define referrers (operation (query-referrers (store-path path)) "Return the list of path that refer to PATH." diff --git a/tests/store.scm b/tests/store.scm index 5ae036c060..a61d449fb4 100644 --- a/tests/store.scm +++ b/tests/store.scm @@ -162,6 +162,38 @@ (equal? (valid-derivers %store o) (list (derivation-file-name d)))))) +(test-assert "topologically-sorted, one item" + (let* ((a (add-text-to-store %store "a" "a")) + (b (add-text-to-store %store "b" "b" (list a))) + (c (add-text-to-store %store "c" "c" (list b))) + (d (add-text-to-store %store "d" "d" (list c))) + (s (topologically-sorted %store (list d)))) + (equal? s (list a b c d)))) + +(test-assert "topologically-sorted, several items" + (let* ((a (add-text-to-store %store "a" "a")) + (b (add-text-to-store %store "b" "b" (list a))) + (c (add-text-to-store %store "c" "c" (list b))) + (d (add-text-to-store %store "d" "d" (list c))) + (s1 (topologically-sorted %store (list d a c b))) + (s2 (topologically-sorted %store (list b d c a b d)))) + (equal? s1 s2 (list a b c d)))) + +(test-assert "topologically-sorted, more difficult" + (let* ((a (add-text-to-store %store "a" "a")) + (b (add-text-to-store %store "b" "b" (list a))) + (c (add-text-to-store %store "c" "c" (list b))) + (d (add-text-to-store %store "d" "d" (list c))) + (w (add-text-to-store %store "w" "w")) + (x (add-text-to-store %store "x" "x" (list w))) + (y (add-text-to-store %store "y" "y" (list x d))) + (s1 (topologically-sorted %store (list y))) + (s2 (topologically-sorted %store (list c y))) + (s3 (topologically-sorted %store (cons y (references %store y))))) + (and (equal? s1 (list w x a b c d y)) + (equal? s2 (list a b c w x d y)) + (lset= string=? s1 s3)))) + (test-assert "log-file, derivation" (let* ((b (add-text-to-store %store "build" "echo $foo > $out" '())) (s (add-to-store %store "bash" #t "sha256"