Delete test file after all tests have run in order to make "make

[bpt/guile.git] / test-suite / tests / ports.test

diff --git a/test-suite/tests/ports.test b/test-suite/tests/ports.test
index d134972..b738dc9 100644 (file)
--- a/test-suite/tests/ports.test
+++ b/test-suite/tests/ports.test
@@ -1,7 +1,7 @@
 ;;;; ports.test --- test suite for Guile I/O ports     -*- scheme -*-
 ;;;; Jim Blandy <jimb@red-bean.com> --- May 1999
 ;;;;
-;;;;   Copyright (C) 1999, 2001 Free Software Foundation, Inc.
+;;;;   Copyright (C) 1999, 2001, 2004, 2006 Free Software Foundation, Inc.
 ;;;; 
 ;;;; This program is free software; you can redistribute it and/or modify
 ;;;; it under the terms of the GNU General Public License as published by
@@ -15,8 +15,8 @@
 ;;;; 
 ;;;; You should have received a copy of the GNU General Public License
 ;;;; along with this software; see the file COPYING.  If not, write to
-;;;; the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
-;;;; Boston, MA 02111-1307 USA
+;;;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;;;; Boston, MA 02110-1301 USA
 
 (define-module (test-suite test-ports)
   :use-module (test-suite lib)
@@ -281,7 +281,7 @@
                                               (string-ref text 0))))))
 
   ;; seeking an output string.
-  (let* ((text "123456789")
+  (let* ((text (string-copy "123456789"))
         (len (string-length text))
         (result (call-with-output-string
                  (lambda (p)
@@ -538,6 +538,42 @@
        (while (not (eof-object? (read-char 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
 
@@ -590,3 +626,5 @@
                    (procedure)))))
            (list read read-char read-line)
            '("read" "read-char" "read-line")))
+
+(delete-file (test-file))