1999-08-04 Gary Houston <ghouston@easynet.co.uk>
authorGary Houston <ghouston@arglist.com>
Wed, 4 Aug 1999 19:00:34 +0000 (19:00 +0000)
committerGary Houston <ghouston@arglist.com>
Wed, 4 Aug 1999 19:00:34 +0000 (19:00 +0000)
* tests/ports.test: tests for buffered and unbuffered input/output
fports with seeking.

test-suite/ChangeLog
test-suite/tests/ports.test

index e376541..3f964f1 100644 (file)
@@ -1,3 +1,8 @@
+1999-08-04  Gary Houston  <ghouston@easynet.co.uk>
+
+       * tests/ports.test: tests for buffered and unbuffered input/output
+       fports with seeking.
+
 1999-08-01  Jim Blandy  <jimb@savonarola.red-bean.com>
 
        * tests/r4rs.test (SECTION 3 4): Each element of type-matrix
index 7cc727d..1f34c9b 100644 (file)
              (equal? string in-string)))
    (delete-file filename)))
 
+;;; Buffered input/output port with seeking.
+(catch-test-errors
+ (let* ((filename (test-file))
+       (port (open-file filename "w+")))
+   (display "J'Accuse" port)
+   (lseek port -1 SEEK_CUR)
+   (pass-if "file: r/w 1"
+           (char=? (read-char port) #\e))
+   (pass-if "file: r/w 2"
+           (eof-object? (read-char port)))
+   (lseek port -1 SEEK_CUR)
+   (write-char #\x port)
+   (lseek port 7 SEEK_SET)
+   (pass-if "file: r/w 3"
+           (char=? (read-char port) #\x))
+   (lseek port -2 SEEK_END)
+   (pass-if "file: r/w 4"
+           (char=? (read-char port) #\s))
+   (delete-file filename)))
+
+;;; Unbuffered input/output port with seeking.
+(catch-test-errors
+ (let* ((filename (test-file))
+       (port (open-file filename "w+0")))
+   (display "J'Accuse" port)
+   (lseek port -1 SEEK_CUR)
+   (pass-if "file: ub r/w 1"
+           (char=? (read-char port) #\e))
+   (pass-if "file: ub r/w 2"
+           (eof-object? (read-char port)))
+   (lseek port -1 SEEK_CUR)
+   (write-char #\x port)
+   (lseek port 7 SEEK_SET)
+   (pass-if "file: ub r/w 3"
+           (char=? (read-char port) #\x))
+   (lseek port -2 SEEK_END)
+   (pass-if "file: ub r/w 4"
+           (char=? (read-char port) #\s))
+   (delete-file filename)))
+
 \f
 ;;;; Pipe ports.