mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-20 10:40:19 +02:00
Code Activity

(truncate-file): New tests.

Browse source
This commit is contained in:
Kevin Ryde 2006-04-16 01:39:08 +00:00
parent c783f5891a
commit da58419409
1 changed files with 36 additions and 0 deletions
Download patch file Download diff file Expand all files Collapse all files

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

@ -538,6 +538,42 @@
(while (not (eof-object? (read-char port)))) (while (not (eof-object? (read-char port))))
(= 8 (port-column port)))))) (= 8 (port-column port))))))
;;;
;;; truncate-file
;;;
(with-test-prefix "truncate-file"
(with-test-prefix "filename"
(pass-if "shorten"
(call-with-output-file (test-file)
(lambda (port)
(display "hello" port)))
(truncate-file (test-file) 1)
(eqv? 1 (stat:size (stat (test-file))))))
(with-test-prefix "file descriptor"
(pass-if "shorten"
(call-with-output-file (test-file)
(lambda (port)
(display "hello" port)))
(let ((fd (open-fdes (test-file) O_RDWR)))
(truncate-file fd 1)
(close-fdes fd))
(eqv? 1 (stat:size (stat (test-file))))))
(with-test-prefix "file port"
(pass-if "shorten"
(call-with-output-file (test-file)
(lambda (port)
(display "hello" port)))
(let ((port (open-file (test-file) "r+")))
(truncate-file port 1))
(eqv? 1 (stat:size (stat (test-file)))))))
;;;; testing read-delimited and friends ;;;; testing read-delimited and friends