aboutsummaryrefslogtreecommitdiff
path: root/tests/derivations.scm
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2012-06-10 22:43:02 +0200
committerLudovic Courtès <ludo@gnu.org>2012-06-10 22:43:02 +0200
commitb37eb5ede67f8f26dcbbb0d9c60050db10b63d00 (patch)
treead4d5454a5370a8907a991f70c74a536a57fdde2 /tests/derivations.scm
parent81095052a8fd25fe56a84c3f5cacc2c2e480e6b5 (diff)
downloadguix-b37eb5ede67f8f26dcbbb0d9c60050db10b63d00.tar
guix-b37eb5ede67f8f26dcbbb0d9c60050db10b63d00.tar.gz
Add `add-to-store' with recursive directory storage.
* guix/store.scm (write-file): Implement directory recursive dump. (add-to-store): Fix the parameter list. * tests/derivations.scm (directory-contents): New procedure. ("add-to-store, recursive"): New test.
Diffstat (limited to 'tests/derivations.scm')
-rw-r--r--tests/derivations.scm31
1 files changed, 29 insertions, 2 deletions
diff --git a/tests/derivations.scm b/tests/derivations.scm
index e2e82e54b3..eb2f360b2a 100644
--- a/tests/derivations.scm
+++ b/tests/derivations.scm
@@ -21,12 +21,14 @@
#:use-module (guix derivations)
#:use-module (guix store)
#:use-module (guix utils)
+ #:use-module (srfi srfi-1)
#:use-module (srfi srfi-11)
#:use-module (srfi srfi-26)
#:use-module (srfi srfi-64)
#:use-module (rnrs io ports)
#:use-module (rnrs bytevectors)
- #:use-module (ice-9 rdelim))
+ #:use-module (ice-9 rdelim)
+ #:use-module (ice-9 ftw))
(define %current-system
;; System type as expected by Nix, usually ARCHITECTURE-KERNEL.
@@ -35,6 +37,24 @@
(define %store
(false-if-exception (open-connection)))
+(define (directory-contents dir)
+ "Return an alist representing the contents of DIR."
+ (define prefix-len (string-length dir))
+ (sort (file-system-fold (const #t) ; enter?
+ (lambda (path stat result) ; leaf
+ (alist-cons (string-drop path prefix-len)
+ (call-with-input-file path
+ get-bytevector-all)
+ result))
+ (lambda (path stat result) result) ; down
+ (lambda (path stat result) result) ; up
+ (lambda (path stat result) result) ; skip
+ (lambda (path stat errno result) result) ; error
+ '()
+ dir)
+ (lambda (e1 e2)
+ (string<? (car e1) (car e2)))))
+
(test-begin "derivations")
(test-assert "parse & export"
@@ -46,7 +66,14 @@
(and (equal? b1 b2)
(equal? d1 d2))))
-(test-skip (if %store 0 3))
+(test-skip (if %store 0 4))
+
+(test-assert "add-to-store, recursive"
+ (let* ((dir (dirname (search-path %load-path "language/tree-il/spec.scm")))
+ (drv (add-to-store %store "dir-tree-test" #t #t "sha256" dir)))
+ (and (eq? 'directory (stat:type (stat drv)))
+ (equal? (directory-contents dir)
+ (directory-contents drv)))))
(test-assert "derivation with no inputs"
(let ((builder (add-text-to-store %store "my-builder.sh"