From 9977b316434c6ac59e0224fd530ab8065f2cc938 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Mon, 10 Dec 2012 23:16:13 +0100 Subject: 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 at . --- test-suite/tests/ftw.test | 28 ++++++++++++++++------------ 1 file 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" -- cgit v1.2.3