diff options
author | Michael Gran <spk121@yahoo.com> | 2023-06-20 13:47:04 -0700 |
---|---|---|
committer | Michael Gran <spk121@yahoo.com> | 2025-03-30 18:10:16 -0700 |
commit | 6b4d829d408973982998c4dfd2730b7d9073f782 (patch) | |
tree | 3bfa6f5ffb1dae076bdb031f057e0d092995afbe | |
parent | cc1c79ae34d1744230790c2f9853182a71361184 (diff) | |
download | guile-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.test | 56 |
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))) |