~ chicken-core (chicken-5) b3affcfd415a71e08e0c53de94759874033f841d

commit b3affcfd415a71e08e0c53de94759874033f841d
Author:     Peter Bex <peter@more-magic.net>
AuthorDate: Thu Sep 2 09:44:13 2021 +0200
Commit:     Mario Domenech Goulart <mario@parenteses.org>
CommitDate: Sun Sep 5 13:05:54 2021 +0200

    Fix posix-tests file permission test on Windows
    
    In Windows, there are three problems with this test:
    
    - Deleting read-only files gives a permission error.
    - Permissions don't know about "group" and "other" permissions - the
      permissions are always extended from the user so the rest match it.
    - It is impossible to give write-only or "no" permissions on a file.
    
    So we make files writable before attempting to delete them, and
    we provide a mapping for expected permissions so that we only look
    at the user part of the file mode, and always have it include
    "readable" as a permission.
    
    See also
    https://docs.microsoft.com/en-us/cpp/c-runtime-library/reference/umask
    and
    https://docs.microsoft.com/en-us/cpp/c-runtime-library/reference/remove-wremove
    
    Signed-off-by: Mario Domenech Goulart <mario@parenteses.org>

diff --git a/tests/posix-tests.scm b/tests/posix-tests.scm
index 26f495e7..1c695d9d 100644
--- a/tests/posix-tests.scm
+++ b/tests/posix-tests.scm
@@ -1,4 +1,5 @@
-(import (chicken pathname)
+(import (chicken bitwise)
+	(chicken pathname)
         (chicken file)
         (chicken file posix)
         (chicken platform)
@@ -89,17 +90,38 @@
 (assert (not (get-environment-variable "FOO")))
 
 ;; file creation and umask interaction
+(define (permission-expectation original-expectation)
+  (cond-expand
+    ;; In Windows, all files are always readable.  You cannot give
+    ;; write-only permissions or no permissions.  Also, there's no
+    ;; concept of "group" and "other", so we must take the user
+    ;; permissions and extend those over the rest.  Finally, it
+    ;; doesn't have an "execute" bit, so ignore that too.
+    (windows (case (arithmetic-shift original-expectation -6)
+	       ((6 7 3 2) #o666)
+	       (else #o444)))
+    (else original-expectation)))
+
+;; For windows, the file must be writable before it can be deleted!
+(define (delete-maybe-readonly-file filename)
+  (cond-expand
+    (windows (when (file-exists? filename)
+	       (set-file-permissions! filename #o666)))
+    (else))
+  (delete-file* filename))
+
 (letrec-syntax ((test (syntax-rules ()
                         ((test umask expected)
                          (test umask "expected" expected "given"))
                         ((test umask given expected)
                          (test umask "expected" expected "given" given))
                         ((test umask "expected" expected "given" given ...)
-                         (let ((mode (file-creation-mode)))
+                         (let ((mode (file-creation-mode))
+			       (exp-perm (permission-expectation expected)))
                            (set! (file-creation-mode) umask)
-                           (delete-file* "posix-tests.out")
+                           (delete-maybe-readonly-file "posix-tests.out")
                            (file-close (file-open "posix-tests.out" open/creat given ...))
-                           (assert (equal? (file-permissions "posix-tests.out") expected))
+                           (assert (equal? (file-permissions "posix-tests.out") exp-perm))
                            (set! (file-creation-mode) mode))))))
   ;; default file mode
   (test #o000 #o666)