test-suite: Skip `EACCES' test of `file-system-fold' when run as root.
authorLudovic Courtès <ludo@gnu.org>
Mon, 10 Dec 2012 22:16:13 +0000 (23:16 +0100)
committerLudovic Courtès <ludo@gnu.org>
Mon, 10 Dec 2012 22:41:06 +0000 (23:41 +0100)
* 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>.

test-suite/tests/ftw.test

index 2a203de..7cd88e4 100644 (file)
       (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"