Browse Source

store: Add 'topologically-sorted'.

* guix/store.scm (topologically-sorted): New procedure.
* tests/store.scm ("topologically-sorted, one item",
  "topologically-sorted, several items", "topologically-sorted, more
  difficult"): New tests.
gn-latest-20200428
Ludovic Courtès 8 years ago
parent
commit
50add47748
  1. 35
      guix/store.scm
  2. 32
      tests/store.scm

35
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."

32
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"

Loading…
Cancel
Save