+(test-assert "write-file-tree + restore-file"
+ (let* ((file1 (search-path %load-path "guix.scm"))
+ (file2 (search-path %load-path "guix/base32.scm"))
+ (file3 "#!/bin/something")
+ (output (string-append %test-dir "/output")))
+ (dynamic-wind
+ (lambda () #t)
+ (lambda ()
+ (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 (stat:size (stat file1))))
+ ("root/lnk"
+ (values 'symlink 0))
+ ("root/dir"
+ (values 'directory 0))
+ ("root/dir/bar"
+ (values 'regular (stat:size (stat file2))))
+ ("root/dir/exe"
+ (values 'executable (string-length file3))))
+ #:file-port
+ (match-lambda
+ ("root/foo" (open-input-file file1))
+ ("root/dir/bar" (open-input-file file2))
+ ("root/dir/exe" (open-input-string file3)))
+ #:symlink-target
+ (match-lambda
+ ("root/lnk" "foo"))
+ #:directory-entries
+ (match-lambda
+ ("root" '("foo" "dir" "lnk"))
+ ("root/dir" '("bar" "exe"))))
+ (close-port port)
+
+ (rm-rf %test-dir)
+ (mkdir %test-dir)
+ (restore-file (open-bytevector-input-port (get-bytevector))
+ output)
+ (and (file=? (string-append output "/foo") file1)
+ (string=? (readlink (string-append output "/lnk"))
+ "foo")
+ (file=? (string-append output "/dir/bar") file2)
+ (string=? (call-with-input-file (string-append output "/dir/exe")
+ get-string-all)
+ file3)
+ (> (logand (stat:mode (lstat (string-append output "/dir/exe")))
+ #o100)
+ 0)
+ (equal? '("." ".." "bar" "exe")
+ (scandir (string-append output "/dir")))
+ (equal? '("." ".." "dir" "foo" "lnk")
+ (scandir output))))
+ (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/dir" directory-complete #f)
+ ("R/foo" regular "abcdefg")
+ ("R/lnk" symlink "foo")
+ ("R" directory-complete #f))
+
+ (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"))))
+