1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-20 03:30:27 +02:00

Fix deletion of ports.test test file on MS-Windows.

* test-suite/tests/ports.test ("fdes->port", "seek")
	("truncate-file"): Close every file and port we open, to avoid
	failure to delete the test file on MS-Windows when the test is
	completed.
This commit is contained in:
Eli Zaretskii 2014-07-02 18:28:06 +03:00
parent c7161ee334
commit 0d77e062dc

View file

@ -1270,9 +1270,10 @@
(with-test-prefix
"fdes->port"
(pass-if "fdes->ports finds port"
(let ((port (open-file (test-file) "w")))
(not (not (memq port (fdes->ports (port->fdes port))))))))
(let* ((port (open-file (test-file) "w"))
(res (not (not (memq port (fdes->ports (port->fdes port)))))))
(close-port port)
res)))
;;;
;;; seek
@ -1289,7 +1290,9 @@
(let ((port (open-file (test-file) "r")))
(read-char port)
(seek port 2 SEEK_CUR)
(eqv? #\d (read-char port))))
(let ((res (eqv? #\d (read-char port))))
(close-port port)
res)))
(pass-if "SEEK_SET"
(call-with-output-file (test-file)
@ -1298,7 +1301,9 @@
(let ((port (open-file (test-file) "r")))
(read-char port)
(seek port 3 SEEK_SET)
(eqv? #\d (read-char port))))
(let ((res (eqv? #\d (read-char port))))
(close-port port)
res)))
(pass-if "SEEK_END"
(call-with-output-file (test-file)
@ -1307,7 +1312,9 @@
(let ((port (open-file (test-file) "r")))
(read-char port)
(seek port -2 SEEK_END)
(eqv? #\d (read-char port))))))
(let ((res (eqv? #\d (read-char port))))
(close-port port)
res)))))
;;;
;;; truncate-file
@ -1370,7 +1377,8 @@
(lambda (port)
(display "hello" port)))
(let ((port (open-file (test-file) "r+")))
(truncate-file port 1))
(truncate-file port 1)
(close-port port))
(eqv? 1 (stat:size (stat (test-file)))))
(pass-if "shorten to current pos"
@ -1379,7 +1387,8 @@
(display "hello" port)))
(let ((port (open-file (test-file) "r+")))
(read-char port)
(truncate-file port))
(truncate-file port)
(close-port port))
(eqv? 1 (stat:size (stat (test-file)))))))