summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2012-12-10 23:16:13 +0100
committerLudovic Courtès <ludo@gnu.org>2012-12-10 23:41:06 +0100
commit9977b316434c6ac59e0224fd530ab8065f2cc938 (patch)
treefd88a61073ce1a52c11bab99ac97858879c2e545
parentcc948107089bf9a8aee25f33f46c8b1dfa914ae6 (diff)
downloadguile-9977b316434c6ac59e0224fd530ab8065f2cc938.tar.gz
test-suite: Skip `EACCES' test of `file-system-fold' when run as root.
* test-suite/tests/ftw.test ("file-system-fold")["EACCES"]: Use `pass-if-equal'. Throw `unresolved' when run as root. Reported by Andreas Enge <andreas@enge.fr> at <http://lists.gnu.org/archive/html/bug-guix/2012-12/msg00073.html>.
-rw-r--r--test-suite/tests/ftw.test28
1 files changed, 16 insertions, 12 deletions
diff --git a/test-suite/tests/ftw.test b/test-suite/tests/ftw.test
index 2a203def1..7cd88e470 100644
--- a/test-suite/tests/ftw.test
+++ b/test-suite/tests/ftw.test
@@ -214,18 +214,22 @@
(equal? (file-system-fold enter? leaf down up skip error '() name)
`((error ,name ,ENOENT)))))
- (pass-if "EACCES"
- (with-file-tree %top-builddir '(directory "test-EACCES" #o000
- (("a") ("b")))
- (let ((enter? (lambda (n s r) #t))
- (leaf (lambda (n s r) (cons `(leaf ,n) r)))
- (down (lambda (n s r) (cons `(down ,n) r)))
- (up (lambda (n s r) (cons `(up ,n) r)))
- (skip (lambda (n s r) (cons `(skip ,n) r)))
- (error (lambda (n s e r) (cons `(error ,n ,e) r)))
- (name (string-append %top-builddir "/test-EACCES")))
- (equal? (file-system-fold enter? leaf down up skip error '() name)
- `((error ,name ,EACCES))))))
+ (let ((name (string-append %top-builddir "/test-EACCES")))
+ (pass-if-equal "EACCES"
+ `((error ,name ,EACCES))
+ (if (zero? (getuid))
+ ;; When run as root, this test would fail because root can
+ ;; list the contents of #o000 directories.
+ (throw 'unresolved)
+ (with-file-tree %top-builddir '(directory "test-EACCES" #o000
+ (("a") ("b")))
+ (let ((enter? (lambda (n s r) #t))
+ (leaf (lambda (n s r) (cons `(leaf ,n) r)))
+ (down (lambda (n s r) (cons `(down ,n) r)))
+ (up (lambda (n s r) (cons `(up ,n) r)))
+ (skip (lambda (n s r) (cons `(skip ,n) r)))
+ (error (lambda (n s e r) (cons `(error ,n ,e) r))))
+ (file-system-fold enter? leaf down up skip error '() name))))))
(pass-if "dangling symlink and lstat"
(with-file-tree %top-builddir '(directory "test-dangling"