mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-04-30 03:40:34 +02:00
Code Activity

in ftw test, skip EACCESS test on MinGW

Browse source 
MinGW ACL-based permissions don't follow POSIX standard, so
'chmod' has unexpected behavior.

* test-suite/tests/ftw.test (mingw?): new define
  ("file system fold: EACCES"): skip test on MinGW
This commit is contained in:
Mike Gran 2022-09-20 19:33:55 -07:00 • committed by Michael Gran
parent 775149f0f5
commit 426ed4068a
1 changed files with 9 additions and 3 deletions
Download patch file Download diff file Expand all files Collapse all files

12
test-suite/tests/ftw.test
View file

@ -23,6 +23,8 @@
#:use-module (srfi srfi-1) #:use-module (srfi srfi-1)
#:use-module (srfi srfi-26)) #:use-module (srfi srfi-26))
(define mingw?
(string-contains %host-type "-mingw32"))
;; the procedure-source checks here ensure the vector indexes we write match ;; the procedure-source checks here ensure the vector indexes we write match
;; what ice-9/posix.scm stat:dev and stat:ino do (which in turn match ;; what ice-9/posix.scm stat:dev and stat:ino do (which in turn match
@ -238,9 +240,13 @@
(let ((name (string-append %top-builddir "/test-EACCES"))) (let ((name (string-append %top-builddir "/test-EACCES")))
(pass-if-equal "EACCES" (pass-if-equal "EACCES"
`((error ,name ,EACCES)) `((error ,name ,EACCES))
(if (and (defined? 'getuid) (zero? (getuid))) (if (or (and (defined? 'getuid) (zero? (getuid)))
;; When run as root, this test would fail because root can ;; When run as root, this test would fail because root can
;; list the contents of #o000 directories. ;; list the contents of #o000 directories.
mingw?
;; MinGW uses ACLs for directory control, which
;; chmod doesn't emulate.
)
(throw 'unresolved) (throw 'unresolved)
(with-file-tree %top-builddir '(directory "test-EACCES" #o000 (with-file-tree %top-builddir '(directory "test-EACCES" #o000
(("a") ("b"))) (("a") ("b")))