;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2012, 2013, 2014 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2012, 2013, 2014, 2015, 2016 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (test-nar)
+ #:use-module (guix tests)
#:use-module (guix nar)
+ #:use-module (guix serialization)
#:use-module (guix store)
- #:use-module ((guix hash) #:select (open-sha256-input-port))
+ #:use-module ((guix hash)
+ #:select (open-sha256-port open-sha256-input-port))
+ #:use-module ((guix packages)
+ #:select (base32))
#:use-module (rnrs bytevectors)
#:use-module (rnrs io ports)
#:use-module (srfi srfi-1)
+ #:use-module (srfi srfi-11)
#:use-module (srfi srfi-26)
#:use-module (srfi srfi-34)
#:use-module (srfi srfi-35)
(cute string-drop <> (string-length input)))
(define sibling
(compose (cut string-append output <>) strip))
- (define (file=? a b)
- (and (eq? (stat:type (lstat a)) (stat:type (lstat b)))
- (case (stat:type (lstat a))
- ((regular)
- (equal?
- (call-with-input-file a get-bytevector-all)
- (call-with-input-file b get-bytevector-all)))
- ((symlink)
- (string=? (readlink a) (readlink b)))
- (else
- (error "what?" (lstat a))))))
(file-system-fold (const #t)
(lambda (name stat result) ; leaf
(lambda (name stat errno result)
(pk 'error name stat errno)
#f)
- (> (stat:nlink (stat output)) 2)
+ #t ; result
input
lstat))
-(define (make-random-bytevector n)
- (let ((bv (make-bytevector n)))
- (let loop ((i 0))
- (if (< i n)
- (begin
- (bytevector-u8-set! bv i (random 256))
- (loop (1+ i)))
- bv))))
-
(define (populate-file file size)
(call-with-output-file file
(lambda (p)
- (put-bytevector p (make-random-bytevector size)))))
+ (put-bytevector p (random-bytevector size)))))
(define (rm-rf dir)
(file-system-fold (const #t) ; enter?
(string-append (dirname (search-path %load-path "pre-inst-env"))
"/test-nar-" (number->string (getpid))))
-;; XXX: Factorize.
-(define %seed
- (seed->random-state (logxor (getpid) (car (gettimeofday)))))
-
-(define (random-text)
- (number->string (random (expt 2 256) %seed) 16))
-
(define-syntax-rule (let/ec k exp...)
;; This one appeared in Guile 2.0.9, so provide a copy here.
(let ((tag (make-prompt-tag)))
\f
(test-begin "nar")
+(test-assert "write-file supports non-file output ports"
+ (let ((input (string-append (dirname (search-path %load-path "guix.scm"))
+ "/guix"))
+ (output (%make-void-port "w")))
+ (write-file input output)
+ #t))
+
+(test-equal "write-file puts file in C locale collation order"
+ (base32 "0sfn5r63k88w9ls4hivnvscg82bqg8a0w7955l6xlk4g96jnb2z3")
+ (let ((input (string-append %test-dir ".input")))
+ (dynamic-wind
+ (lambda ()
+ (define (touch file)
+ (call-with-output-file (string-append input "/" file)
+ (const #t)))
+
+ (mkdir input)
+ (touch "B")
+ (touch "Z")
+ (touch "a")
+ (symlink "B" (string-append input "/z")))
+ (lambda ()
+ (let-values (((port get-hash) (open-sha256-port)))
+ (write-file input port)
+ (get-hash)))
+ (lambda ()
+ (rm-rf input)))))
+
+(test-equal "restore-file with incomplete input"
+ (string-append %test-dir "/foo")
+ (let ((port (open-bytevector-input-port #vu8(1 2 3))))
+ (guard (c ((nar-error? c)
+ (and (eq? port (nar-error-port c))
+ (nar-error-file c))))
+ (restore-file port (string-append %test-dir "/foo"))
+ #f)))
+
(test-assert "write-file + restore-file"
(let* ((input (string-append (dirname (search-path %load-path "guix.scm"))
"/guix"))
(lambda ()
(rmdir input)))))
+(test-assert "write-file #:select? + restore-file"
+ (let ((input (string-append %test-dir ".input")))
+ (mkdir input)
+ (dynamic-wind
+ (const #t)
+ (lambda ()
+ (with-file-tree input
+ (directory "root"
+ ((directory "a" (("x") ("y") ("z")))
+ ("b") ("c") ("d" -> "b")))
+ (let* ((output %test-dir)
+ (nar (string-append output ".nar")))
+ (dynamic-wind
+ (lambda () #t)
+ (lambda ()
+ (call-with-output-file nar
+ (lambda (port)
+ (write-file input port
+ #:select?
+ (lambda (file stat)
+ (and (not (string=? (basename file)
+ "a"))
+ (not (eq? (stat:type stat)
+ 'symlink)))))))
+ (call-with-input-file nar
+ (cut restore-file <> output))
+
+ ;; Make sure "a" and "d" have been filtered out.
+ (and (not (file-exists? (string-append output "/root/a")))
+ (file=? (string-append output "/root/b")
+ (string-append input "/root/b"))
+ (file=? (string-append output "/root/c")
+ (string-append input "/root/c"))
+ (not (file-exists? (string-append output "/root/d")))))
+ (lambda ()
+ (false-if-exception (delete-file nar))
+ (false-if-exception (rm-rf output)))))))
+ (lambda ()
+ (rmdir input)))))
+
;; 'restore-file-set' depends on 'open-sha256-input-port', which in turn
;; relies on a Guile 2.0.10+ feature.
(test-skip (if (false-if-exception
(test-assert "restore-file-set (missing signature)"
(let/ec return
(with-store store
- (let* ((file (add-text-to-store store "foo" "Hello, world!"))
+ (let* ((file (add-text-to-store store "foo" (random-text)))
(dump (call-with-bytevector-output-port
(cute export-paths store (list file) <>
#:sign? #f))))
(test-end "nar")
-\f
-(exit (= (test-runner-fail-count (test-runner-current)) 0))
-
;;; Local Variables:
;;; eval: (put 'with-file-tree 'scheme-indent-function 2)
;;; End: