ryan77627/guix
1
0
Fork 0
mirror of https://git.in.rschanz.org/ryan77627/guix.git synced 2024-12-24 05:18:07 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

store: Add #:recursive? parameter to 'export-paths'.

Browse source 
* guix/store.scm (export-paths): Add #:recursive? parameter and honor
  it.
* tests/store.scm ("export/import incomplete", "export/import
  recursive"): New tests.
This commit is contained in:
Ludovic Courtès 2015-01-17 15:59:00 +01:00
parent 867d847305
commit 5b3d863f00
2 changed files with 41 additions and 5 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

13
guix/store.scm
View file

@ -795,13 +795,16 @@ (define* (export-path server path port #:key (sign? #t))
(or done? (loop (process-stderr server port))))
(= 1 (read-int s))))
(define* (export-paths server paths port #:key (sign? #t))
(define* (export-paths server paths port #:key (sign? #t) recursive?)
"Export the store paths listed in PATHS to PORT, in topological order,
signing them if SIGN? is true."
signing them if SIGN? is true. When RECURSIVE? is true, export the closure of
PATHS---i.e., PATHS and all their dependencies."
(define ordered
;; Sort PATHS, but don't include their references.
(filter (cut member <> paths)
(topologically-sorted server paths)))
(let ((sorted (topologically-sorted server paths)))
;; When RECURSIVE? is #f, filter out the references of PATHS.
(if recursive?
sorted
(filter (cut member <> paths) sorted))))
(let ((s (nix-server-socket server)))
(let loop ((paths ordered))

33
tests/store.scm
View file

@ -552,6 +552,39 @@ (define (same? x y)
(equal? (list file0) (references %store file1))
(equal? (list file1) (references %store file2)))))))
(test-assert "export/import incomplete"
(let* ((file0 (add-text-to-store %store "baz" (random-text)))
(file1 (add-text-to-store %store "foo" (random-text)
(list file0)))
(file2 (add-text-to-store %store "bar" (random-text)
(list file1)))
(dump (call-with-bytevector-output-port
(cute export-paths %store (list file2) <>))))
(delete-paths %store (list file0 file1 file2))
(guard (c ((nix-protocol-error? c)
(and (not (zero? (nix-protocol-error-status c)))
(string-contains (nix-protocol-error-message c)
"not valid"))))
;; Here we get an exception because DUMP does not include FILE0 and
;; FILE1, which are dependencies of FILE2.
(import-paths %store (open-bytevector-input-port dump)))))
(test-assert "export/import recursive"
(let* ((file0 (add-text-to-store %store "baz" (random-text)))
(file1 (add-text-to-store %store "foo" (random-text)
(list file0)))
(file2 (add-text-to-store %store "bar" (random-text)
(list file1)))
(dump (call-with-bytevector-output-port
(cute export-paths %store (list file2) <>
#:recursive? #t))))
(delete-paths %store (list file0 file1 file2))
(let ((imported (import-paths %store (open-bytevector-input-port dump))))
(and (equal? imported (list file0 file1 file2))
(every file-exists? (list file0 file1 file2))
(equal? (list file0) (references %store file1))
(equal? (list file1) (references %store file2))))))
(test-assert "import corrupt path"
(let* ((text (random-text))
(file (add-text-to-store %store "text" text))