aboutsummaryrefslogtreecommitdiff
path: root/tests/nar.scm
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2019-12-04 22:05:31 +0100
committerLudovic Courtès <ludo@gnu.org>2019-12-12 17:56:57 +0100
commit12c1afcdbdc984c760d00932bce64288b385bbc9 (patch)
tree4434ef48e9d7abeb0007b96e1eb06372a75b075a /tests/nar.scm
parent55e21617d68073077fdc9f35307e94859ec7a6c4 (diff)
downloadguix-12c1afcdbdc984c760d00932bce64288b385bbc9.tar
guix-12c1afcdbdc984c760d00932bce64288b385bbc9.tar.gz
serialization: Add 'fold-archive'.
* guix/serialization.scm (read-contents): Remove. (read-file-type, fold-archive): New procedures. (restore-file): Rewrite in terms of 'fold-archive'. * tests/nar.scm ("write-file-tree + fold-archive") ("write-file-tree + fold-archive, flat file"): New tests.
Diffstat (limited to 'tests/nar.scm')
-rw-r--r--tests/nar.scm74
1 files changed, 74 insertions, 0 deletions
diff --git a/tests/nar.scm b/tests/nar.scm
index bfc71c69a8..aeff3d3330 100644
--- a/tests/nar.scm
+++ b/tests/nar.scm
@@ -214,6 +214,80 @@
(lambda ()
(false-if-exception (rm-rf %test-dir))))))
+(test-equal "write-file-tree + fold-archive"
+ '(("R" directory #f)
+ ("R/dir" directory #f)
+ ("R/dir/exe" executable "1234")
+ ("R/foo" regular "abcdefg")
+ ("R/lnk" symlink "foo"))
+
+ (let ()
+ (define-values (port get-bytevector)
+ (open-bytevector-output-port))
+ (write-file-tree "root" port
+ #:file-type+size
+ (match-lambda
+ ("root"
+ (values 'directory 0))
+ ("root/foo"
+ (values 'regular 7))
+ ("root/lnk"
+ (values 'symlink 0))
+ ("root/dir"
+ (values 'directory 0))
+ ("root/dir/exe"
+ (values 'executable 4)))
+ #:file-port
+ (match-lambda
+ ("root/foo" (open-input-string "abcdefg"))
+ ("root/dir/exe" (open-input-string "1234")))
+ #:symlink-target
+ (match-lambda
+ ("root/lnk" "foo"))
+ #:directory-entries
+ (match-lambda
+ ("root" '("foo" "dir" "lnk"))
+ ("root/dir" '("exe"))))
+ (close-port port)
+
+ (reverse
+ (fold-archive (lambda (file type contents result)
+ (let ((contents (if (memq type '(regular executable))
+ (utf8->string
+ (get-bytevector-n (car contents)
+ (cdr contents)))
+ contents)))
+ (cons `(,file ,type ,contents)
+ result)))
+ '()
+ (open-bytevector-input-port (get-bytevector))
+ "R"))))
+
+(test-equal "write-file-tree + fold-archive, flat file"
+ '(("R" regular "abcdefg"))
+
+ (let ()
+ (define-values (port get-bytevector)
+ (open-bytevector-output-port))
+ (write-file-tree "root" port
+ #:file-type+size
+ (match-lambda
+ ("root" (values 'regular 7)))
+ #:file-port
+ (match-lambda
+ ("root" (open-input-string "abcdefg"))))
+ (close-port port)
+
+ (reverse
+ (fold-archive (lambda (file type contents result)
+ (let ((contents (utf8->string
+ (get-bytevector-n (car contents)
+ (cdr contents)))))
+ (cons `(,file ,type ,contents) result)))
+ '()
+ (open-bytevector-input-port (get-bytevector))
+ "R"))))
+
(test-assert "write-file supports non-file output ports"
(let ((input (string-append (dirname (search-path %load-path "guix.scm"))
"/guix"))