summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorMichael Gran <spk121@yahoo.com>2023-06-20 13:47:04 -0700
committerMichael Gran <spk121@yahoo.com>2025-03-30 18:10:16 -0700
commit6b4d829d408973982998c4dfd2730b7d9073f782 (patch)
tree3bfa6f5ffb1dae076bdb031f057e0d092995afbe
parentcc1c79ae34d1744230790c2f9853182a71361184 (diff)
downloadguile-6b4d829d408973982998c4dfd2730b7d9073f782.tar.gz
in filesys test, add helper function for deleting files and symlinks
On Windows, a file needs to have write permission to be deleted. This adds a helper to handle that case, but, is used generally. * test-suite/tests/filesys.test (%delete-file): new helper function Replace every delete-file call with %delete-file.
-rw-r--r--test-suite/tests/filesys.test56
1 files changed, 29 insertions, 27 deletions
diff --git a/test-suite/tests/filesys.test b/test-suite/tests/filesys.test
index 55f67e41a..7afa87569 100644
--- a/test-suite/tests/filesys.test
+++ b/test-suite/tests/filesys.test
@@ -38,6 +38,14 @@
(when (string-ci=? "darwin" (utsname:sysname (uname)))
(throw 'untested)))
+(define (%delete-file file)
+ ;; lstat finds files and links. stat finds just files.
+ (when (false-if-exception (lstat file))
+ ;; MinGW requires write permission to delete a file.
+ (when (and (stat file #f) (not (access? file W_OK)))
+ (chmod file (logior (stat:mode (stat file)) #o200)))
+ (delete-file file)))
+
;;;
;;; copy-file
;;;
@@ -99,7 +107,7 @@
(call-with-output-file (test-file)
(lambda (port)
(display "hello" port)))
- (false-if-exception (delete-file (test-symlink)))
+ (%delete-file (test-symlink))
(if (not (false-if-exception
(begin (symlink (test-file) (test-symlink)) #t)))
(display "cannot create symlink, lstat test skipped\n")
@@ -182,8 +190,7 @@
(for-each
(lambda (filename)
(define full-name (in-vicinity (test-directory) filename))
- (when (file-exists? full-name)
- (delete-file full-name)))
+ (%delete-file full-name))
'("test-file" "test-symlink"))
(rmdir (test-directory))))
(define (skip-unless-defined . things)
@@ -351,9 +358,8 @@
;; https://debbugs.gnu.org/69437
(pass-if-equal "bar" (basename "foo/bar" "o/bar")))
-(delete-file (test-file))
-(when (file-exists? (test-symlink))
- (delete-file (test-symlink)))
+(%delete-file (test-file))
+(%delete-file (test-symlink))
(with-test-prefix "mkdtemp"
@@ -493,8 +499,8 @@
(chdir (open-input-string ""))))
(with-test-prefix "readlink"
- (false-if-exception (delete-file (test-symlink)))
- (false-if-exception (delete-file (test-file)))
+ (%delete-file (test-symlink))
+ (%delete-file (test-file))
(call-with-output-file (test-file)
(lambda (port)
(display "hello" port)))
@@ -550,8 +556,8 @@
(close-port port)
(readlink port)))
- (false-if-exception (delete-file (test-symlink)))
- (false-if-exception (delete-file (test-file))))
+ (%delete-file (test-symlink))
+ (%delete-file (test-file)))
(with-test-prefix "symlinkat"
(pass-if-equal "create" (test-file)
@@ -562,7 +568,7 @@
(lambda (port)
(symlinkat port (test-file) (test-symlink))
(readlink (test-symlink)))))
- (false-if-exception (delete-file (test-symlink)))
+ (%delete-file (test-symlink))
(pass-if-exception "not a port" exception:wrong-type-arg
(unless (defined? 'symlinkat)
@@ -631,8 +637,8 @@
(list (file-exists? "filesys-test-a.tmp")
(call-with-input-file "filesys-test-b.tmp" get-string-all)))
- (false-if-exception (delete-file "filesys-test-a.tmp"))
- (false-if-exception (delete-file "filesys-test-b.tmp"))
+ (%delete-file "filesys-test-a.tmp")
+ (%delete-file "filesys-test-b.tmp")
(pass-if-equal "two ports" '(#f "hello")
(skip-if-unsupported)
@@ -651,8 +657,8 @@
(list (file-exists? (in-vicinity (test-directory) "a"))
(call-with-input-file (in-vicinity (test-directory2) "b")
get-string-all))))
- (false-if-exception (delete-file (in-vicinity (test-directory) "a")))
- (false-if-exception (delete-file (in-vicinity (test-directory2) "b")))
+ (%delete-file (in-vicinity (test-directory) "a"))
+ (%delete-file (in-vicinity (test-directory2) "b"))
(false-if-exception (rmdir (test-directory)))
(false-if-exception (rmdir (test-directory2)))
@@ -669,9 +675,9 @@
;; Verify it exists under the new name, and not under the old name.
(list (file-exists? (in-vicinity (test-directory) "a"))
(call-with-input-file (test-file) get-string-all))))
- (false-if-exception (delete-file (in-vicinity (test-directory) "a")))
+ (%delete-file (in-vicinity (test-directory) "a"))
(false-if-exception (rmdir (test-directory)))
- (false-if-exception (delete-file (test-file)))
+ (%delete-file (test-file))
(pass-if-equal "current working directory and port" '(#f "hello")
(skip-if-unsupported)
@@ -688,8 +694,8 @@
(call-with-input-file (in-vicinity (test-directory) "b")
get-string-all))))
- (false-if-exception (delete-file (in-vicinity (test-directory) "b")))
- (false-if-exception (delete-file (test-file)))
+ (%delete-file (in-vicinity (test-directory) "b"))
+ (%delete-file (test-file))
(false-if-exception (rmdir (test-directory)))
(pass-if-exception "not a file port (1)" exception:wrong-type-arg
@@ -728,8 +734,7 @@
(define (create-test-directory)
(mkdir (test-directory)))
(define (delete-test-file)
- (when (file-exists? (test-file))
- (delete-file (test-file))))
+ (%delete-file (test-file)))
(define (delete-test-directory)
(when (file-exists? (test-directory))
(rmdir (test-directory))))
@@ -808,8 +813,7 @@
(list (basename file) O_RDONLY)
(lambda (port) (port-revealed port))))
- (when (file-exists? (test-file))
- (delete-file (test-file)))
+ (%delete-file (test-file))
(pass-if-equal "O_CREAT/O_WRONLY" (list #t (logand (lognot (umask)) #o666) "w")
(skip-if-unsupported)
@@ -821,8 +825,7 @@
(stat:perms (stat (test-file)))
(port-mode port)))))
- (when (file-exists? (test-file))
- (delete-file (test-file)))
+ (%delete-file (test-file))
(pass-if-equal "O_CREAT/O_WRONLY, non-default mode"
(list #t (logand (lognot (umask)) #o700) "w")
@@ -847,5 +850,4 @@
(skip-if-unsupported)
(openat "not a port" "." O_RDONLY))
- (when (file-exists? (test-file))
- (delete-file (test-file))))
+ (%delete-file (test-file)))