amaharaneko/guix-mirrors
1
1
Fork 0
mirror of https://codeberg.org/guix/guix.git synced 2025-10-02 02:15:12 +00:00
Code Issues Projects Releases Packages Wiki Activity Actions

serialization: Add 'write-file-tree'.

Browse source 
* guix/serialization.scm (write-contents-from-port): New procedure.
(write-contents): Write in terms of 'write-contents-from-port'.
(filter/sort-directory-entries, write-file-tree): New procedures.
(write-file): Rewrite in terms of 'write-file-tree'.
* tests/nar.scm ("write-file-tree + restore-file"): New test.
This commit is contained in:
Ludovic Courtès 2018-07-14 19:28:07 +02:00
parent ec83abad85
commit b94b698d4e
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5
2 changed files with 169 additions and 33 deletions
Download patch file Download diff file Expand all files Collapse all files

62
tests/nar.scm
View file

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@ -152,6 +152,66 @@
(test-begin "nar")
(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-assert "write-file supports non-file output ports"
(let ((input (string-append (dirname (search-path %load-path "guix.scm"))
"/guix"))