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 test suite, ensure file ports are closed before deletion

Browse source 
On Windows, open file ports cannot be deleted.

* test-suite/tests/ports.test ("relative canonicalization with common prefixes"):
    close port before deletion
* test-suite/tests/posix.test (utime-unless-unsupported): take a port arg
  ("file port"): use new utime-unless-unsupported. Close port before deletion.
* test-suite/tests/filesys.test ("port representing a regular file"):
    throw unsupported before creating file
This commit is contained in:
Michael Gran 2023-06-20 11:38:24 -07:00
parent 1174e1eb9d
commit cc1c79ae34
2 changed files with 12 additions and 8 deletions
Download patch file Download diff file Expand all files Collapse all files

8
test-suite/tests/ports.test
View file

@ -2061,7 +2061,8 @@
;; In Guile up to 2.2.2, this would return "wrong/x.scm'.
(let* ((dir1 (string-append %temporary-directory "/something"))
(dir2 (string-append dir1 "-wrong")))
(dir2 (string-append dir1 "-wrong"))
(p #f))
(with-load-path (append (list dir1 dir2) %load-path)
(dynamic-wind
(lambda ()
@ -2072,9 +2073,10 @@
(const #t)))
(lambda ()
(with-fluids ((%file-port-name-canonicalization 'relative))
(port-filename
(open-input-file (string-append dir2 "/x.scm")))))
(set! p (open-input-file (string-append dir2 "/x.scm")))
(port-filename p)))
(lambda ()
(close p)
(delete-file (string-append dir2 "/x.scm"))
(rmdir dir2)
(rmdir dir1)

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

@ -208,19 +208,19 @@
(delete-file file))))
(throw 'unsupported)))
(define (utime-unless-unsupported oops . arguments)
(define (utime-unless-unsupported oops port . arguments)
(catch 'system-error
(lambda ()
(catch 'wrong-type-arg
(lambda ()
(apply utime arguments))
(apply utime port arguments))
(lambda _
;; 'futimens' is not supported on all platforms.
(oops))))
(oops port))))
(lambda args
;; On some platforms, 'futimens' returns ENOSYS according to Gnulib.
(if (= (system-error-errno args) ENOSYS)
(oops)
(oops port)
(apply throw args)))))
(pass-if-equal "file port"
@ -230,13 +230,15 @@
(close-port (open-output-file file))
(define (delete)
(delete-file file))
(define (oops)
(define (oops port)
(close port)
(delete)
(throw 'unsupported))
(call-with-input-file file
(lambda (port)
(utime-unless-unsupported oops port 1 1 0 0)
(define info (stat file))
(close port)
(delete)
(list (stat:atime info) (stat:mtime info))))))