diff options
author | Ludovic Courtès <ludo@gnu.org> | 2012-12-10 23:16:13 +0100 |
---|---|---|
committer | Ludovic Courtès <ludo@gnu.org> | 2012-12-10 23:41:06 +0100 |
commit | 9977b316434c6ac59e0224fd530ab8065f2cc938 (patch) | |
tree | fd88a61073ce1a52c11bab99ac97858879c2e545 | |
parent | cc948107089bf9a8aee25f33f46c8b1dfa914ae6 (diff) | |
download | guile-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.test | 28 |
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" |