diff options
| author | Ludovic Courtès <ludo@gnu.org> | 2016-06-12 23:22:54 +0200 |
|---|---|---|
| committer | Ludovic Courtès <ludo@gnu.org> | 2016-06-12 23:55:22 +0200 |
| commit | fe585be9aa8f5158a7dfb6477d19ece3d643dec3 (patch) | |
| tree | 855b01af0646dee9186ae539fd9f561e47777649 /tests | |
| parent | 31d968fbcfa78b52c5280503417b67943f8a9660 (diff) | |
| download | gnu-guix-fe585be9aa8f5158a7dfb6477d19ece3d643dec3.tar gnu-guix-fe585be9aa8f5158a7dfb6477d19ece3d643dec3.tar.gz | |
serialization: Add #:select? parameter to 'write-file'.
* guix/serialization.scm (write-file): Add #:select? parameter and honor it.
* tests/nar.scm ("write-file #:select? + restore-file"): New test.
Diffstat (limited to 'tests')
| -rw-r--r-- | tests/nar.scm | 42 |
1 files changed, 41 insertions, 1 deletions
diff --git a/tests/nar.scm b/tests/nar.scm index 9796980e35..4f4b304b1d 100644 --- a/tests/nar.scm +++ b/tests/nar.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2012, 2013, 2014, 2015 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. ;;; @@ -241,6 +241,46 @@ (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 |