[git] CMU Common Lisp branch master updated. snapshot-2014-01-8-g189dc5b
Raymond Toy
rtoy at common-lisp.net
Wed Jan 8 04:29:31 UTC 2014
This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "CMU Common Lisp".
The branch, master has been updated
via 189dc5b6a717ad0a93354e55d87bc0ab41e6745d (commit)
via 866c8bcf2fc93eb6dacd5707ff0e4cacea72734b (commit)
from 87ef443f0e2df10676b2680c31e0a3cf459882da (commit)
Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.
- Log -----------------------------------------------------------------
commit 189dc5b6a717ad0a93354e55d87bc0ab41e6745d
Author: Raymond Toy <toy.raymond at gmail.com>
Date: Tue Jan 7 20:29:16 2014 -0800
Convert to using lisp-unit. Disable the two inet tests since the echo
server is not running on my machines.
diff --git a/tests/simple-streams.lisp b/tests/simple-streams.lisp
index 7a9a24f..9d70d55 100644
--- a/tests/simple-streams.lisp
+++ b/tests/simple-streams.lisp
@@ -2,11 +2,11 @@
(require :simple-streams)
-(defpackage simple-streams-test
- (:use #:common-lisp #:stream #:rt))
+(defpackage simple-streams-tests
+ (:use #:common-lisp #:stream #:lisp-unit))
-(in-package #:simple-streams-test)
+(in-package #:simple-streams-tests)
(defparameter *dumb-string*
"This file was created by simple-stream-tests.lisp. Nothing to see here, move along.")
@@ -69,176 +69,190 @@
(progn , at body))
,(when delete-afterwards `(ignore-errors (delete-file ,file))))))
-(deftest create-file-1
- ;; Create a file-simple-stream, write data.
- (prog1
- (with-open-stream (s (make-instance 'file-simple-stream
- :filename *test-file*
- :direction :output
- :external-format :latin-1
- :if-exists :overwrite
- :if-does-not-exist :create))
- (string= (write-string *dumb-string* s) *dumb-string*))
- (delete-file *test-file*))
- t)
-
-(deftest create-file-2
- ;; Create a file-simple-stream via :class argument to open, write data.
- (with-test-file (s *test-file* :class 'file-simple-stream
- :direction :output :if-exists :overwrite
- :if-does-not-exist :create)
- (string= (write-string *dumb-string* s) *dumb-string*))
- t)
-
-(deftest create-read-file-1
+(define-test create-file-1
+ ;; Create a file-simple-stream, write data.
+ (assert-eql
+ t
+ (prog1
+ (with-open-stream (s (make-instance 'file-simple-stream
+ :filename *test-file*
+ :direction :output
+ :external-format :latin-1
+ :if-exists :overwrite
+ :if-does-not-exist :create))
+ (string= (write-string *dumb-string* s) *dumb-string*))
+ (delete-file *test-file*))))
+
+(define-test create-file-2
+ ;; Create a file-simple-stream via :class argument to open, write data.
+ (assert-eql
+ t
+ (with-test-file (s *test-file* :class 'file-simple-stream
+ :direction :output :if-exists :overwrite
+ :if-does-not-exist :create)
+ (string= (write-string *dumb-string* s) *dumb-string*))))
+
+(define-test create-read-file-1
;; Via file-simple-stream objects, write and then re-read data.
- (let ((result t))
- (with-test-file (s *test-file* :class 'file-simple-stream
- :direction :output :if-exists :overwrite
- :if-does-not-exist :create :delete-afterwards nil)
- (write-line *dumb-string* s)
- (setf result (and result (string= (write-string *dumb-string* s)
- *dumb-string*))))
-
- (with-test-file (s *test-file* :class 'file-simple-stream
- :direction :input :if-does-not-exist :error)
- ;; Check first line
- (multiple-value-bind (string missing-newline-p)
- (read-line s)
- (setf result (and result (string= string *dumb-string*)
- (not missing-newline-p))))
- ;; Check second line
- (multiple-value-bind (string missing-newline-p)
- (read-line s)
- (setf result (and result (string= string *dumb-string*)
- missing-newline-p))))
- result)
- t)
-
-(deftest create-read-mapped-file-1
+ (assert-eql
+ t
+ (let ((result t))
+ (with-test-file (s *test-file* :class 'file-simple-stream
+ :direction :output :if-exists :overwrite
+ :if-does-not-exist :create :delete-afterwards nil)
+ (write-line *dumb-string* s)
+ (setf result (and result (string= (write-string *dumb-string* s)
+ *dumb-string*))))
+
+ (with-test-file (s *test-file* :class 'file-simple-stream
+ :direction :input :if-does-not-exist :error)
+ ;; Check first line
+ (multiple-value-bind (string missing-newline-p)
+ (read-line s)
+ (setf result (and result (string= string *dumb-string*)
+ (not missing-newline-p))))
+ ;; Check second line
+ (multiple-value-bind (string missing-newline-p)
+ (read-line s)
+ (setf result (and result (string= string *dumb-string*)
+ missing-newline-p))))
+ result)))
+
+(define-test create-read-mapped-file-1
;; Read data via a mapped-file-simple-stream object.
- (let ((result t))
- (with-test-file (s *test-file* :class 'mapped-file-simple-stream
- :direction :input :if-does-not-exist :error
- :initial-content *dumb-string*)
- (setf result (and result (string= (read-line s) *dumb-string*))))
- result)
- t)
-
-(deftest write-read-inet
+ (assert-eql
+ t
+ (let ((result t))
+ (with-test-file (s *test-file* :class 'mapped-file-simple-stream
+ :direction :input :if-does-not-exist :error
+ :initial-content *dumb-string*)
+ (setf result (and result (string= (read-line s) *dumb-string*))))
+ result)))
+
+#+(or)
+(define-test write-read-inet
;; Open a socket-simple-stream to the echo service and test if we
;; get it echoed back. Obviously fails if the echo service isn't
;; enabled.
- (with-open-stream (s (make-instance 'socket-simple-stream
- :remote-host *echo-server*
- :remote-port 7
- :direction :io))
- (string= (prog1
- (write-line "Got it!" s)
- (finish-output s))
- (read-line s)))
- t)
-
-(deftest write-read-large-sc-1
+ (assert-eql
+ t
+ (with-open-stream (s (make-instance 'socket-simple-stream
+ :remote-host *echo-server*
+ :remote-port 7
+ :direction :io))
+ (string= (prog1
+ (write-line "Got it!" s)
+ (finish-output s))
+ (read-line s)))))
+
+(define-test write-read-large-sc-1
;; Do write and read with more data than the buffer will hold
;; (single-channel simple-stream)
- (let* ((stream (make-instance 'file-simple-stream
- :filename *test-file* :direction :output
- :external-format :latin-1
- :if-exists :overwrite
- :if-does-not-exist :create))
- (content (make-string (1+ (device-buffer-length stream))
- :initial-element #\x)))
- (with-open-stream (s stream)
- (write-string content s))
- (with-test-file (s *test-file* :class 'file-simple-stream
- :direction :input :if-does-not-exist :error)
- (string= content (read-line s))))
- t)
-
-(deftest write-read-large-sc-2
- (let* ((stream (make-instance 'file-simple-stream
- :filename *test-file* :direction :output
- :external-format :latin-1
- :if-exists :overwrite
- :if-does-not-exist :create))
- (length (1+ (* 3 (device-buffer-length stream))))
- (content (make-string length)))
- (dotimes (i (length content))
- (setf (aref content i) (code-char (random 256))))
- (with-open-stream (s stream)
- (write-string content s))
- (with-test-file (s *test-file* :class 'file-simple-stream
- :direction :input :if-does-not-exist :error)
- (let ((seq (make-string length)))
- #+nil (read-sequence seq s)
- #-nil (dotimes (i length)
- (setf (char seq i) (read-char s)))
- (string= content seq))))
- t)
-
-(deftest write-read-large-sc-read-seq-2
- (let* ((stream (make-instance 'file-simple-stream
- :filename *test-file* :direction :output
- :external-format :latin-1
- :if-exists :overwrite
- :if-does-not-exist :create))
- (length (1+ (* 3 (device-buffer-length stream))))
- (content (make-string length)))
- (dotimes (i (length content))
- (setf (aref content i) (code-char (random 256))))
- (with-open-stream (s stream)
- (write-string content s))
- (with-test-file (s *test-file* :class 'file-simple-stream
- :direction :input :if-does-not-exist :error)
- (let ((seq (make-string length)))
- (read-sequence seq s)
- (string= content seq))))
- t)
-
-(deftest write-read-large-sc-3
- (let* ((stream (make-instance 'file-simple-stream
- :filename *test-file* :direction :output
- :external-format :latin-1
- :if-exists :overwrite
- :if-does-not-exist :create))
- (length (1+ (* 3 (device-buffer-length stream))))
- (content (make-array length :element-type '(unsigned-byte 8))))
- (dotimes (i (length content))
- (setf (aref content i) (random 256)))
- (with-open-stream (s stream)
- (write-sequence content s))
- (with-test-file (s *test-file* :class 'file-simple-stream
- :direction :input :if-does-not-exist :error)
- (let ((seq (make-array length :element-type '(unsigned-byte 8))))
- #+nil (read-sequence seq s)
- #-nil (dotimes (i length)
- (setf (aref seq i) (read-byte s)))
- (equalp content seq))))
- t)
-
-(deftest write-read-large-sc-read-seq-3
- (let* ((stream (make-instance 'file-simple-stream
- :filename *test-file* :direction :output
- :external-format :latin-1
- :if-exists :overwrite
- :if-does-not-exist :create))
- (length (1+ (* 3 (device-buffer-length stream))))
- (content (make-array length :element-type '(unsigned-byte 8))))
- (dotimes (i (length content))
- (setf (aref content i) (random 256)))
- (with-open-stream (s stream)
- (write-sequence content s))
- (with-test-file (s *test-file* :class 'file-simple-stream
- :direction :input :if-does-not-exist :error)
- (let ((seq (make-array length :element-type '(unsigned-byte 8))))
- (read-sequence seq s)
- (equalp content seq))))
- t)
-
-(deftest write-read-large-dc-1
+ (assert-eql
+ t
+ (let* ((stream (make-instance 'file-simple-stream
+ :filename *test-file* :direction :output
+ :external-format :latin-1
+ :if-exists :overwrite
+ :if-does-not-exist :create))
+ (content (make-string (1+ (device-buffer-length stream))
+ :initial-element #\x)))
+ (with-open-stream (s stream)
+ (write-string content s))
+ (with-test-file (s *test-file* :class 'file-simple-stream
+ :direction :input :if-does-not-exist :error)
+ (string= content (read-line s))))))
+
+(define-test write-read-large-sc-2
+ (assert-eql
+ t
+ (let* ((stream (make-instance 'file-simple-stream
+ :filename *test-file* :direction :output
+ :external-format :latin-1
+ :if-exists :overwrite
+ :if-does-not-exist :create))
+ (length (1+ (* 3 (device-buffer-length stream))))
+ (content (make-string length)))
+ (dotimes (i (length content))
+ (setf (aref content i) (code-char (random 256))))
+ (with-open-stream (s stream)
+ (write-string content s))
+ (with-test-file (s *test-file* :class 'file-simple-stream
+ :direction :input :if-does-not-exist :error)
+ (let ((seq (make-string length)))
+ #+nil (read-sequence seq s)
+ #-nil (dotimes (i length)
+ (setf (char seq i) (read-char s)))
+ (string= content seq))))))
+
+(define-test write-read-large-sc-read-seq-2
+ (assert-eql
+ t
+ (let* ((stream (make-instance 'file-simple-stream
+ :filename *test-file* :direction :output
+ :external-format :latin-1
+ :if-exists :overwrite
+ :if-does-not-exist :create))
+ (length (1+ (* 3 (device-buffer-length stream))))
+ (content (make-string length)))
+ (dotimes (i (length content))
+ (setf (aref content i) (code-char (random 256))))
+ (with-open-stream (s stream)
+ (write-string content s))
+ (with-test-file (s *test-file* :class 'file-simple-stream
+ :direction :input :if-does-not-exist :error)
+ (let ((seq (make-string length)))
+ (read-sequence seq s)
+ (string= content seq))))))
+
+(define-test write-read-large-sc-3
+ (assert-eql
+ t
+ (let* ((stream (make-instance 'file-simple-stream
+ :filename *test-file* :direction :output
+ :external-format :latin-1
+ :if-exists :overwrite
+ :if-does-not-exist :create))
+ (length (1+ (* 3 (device-buffer-length stream))))
+ (content (make-array length :element-type '(unsigned-byte 8))))
+ (dotimes (i (length content))
+ (setf (aref content i) (random 256)))
+ (with-open-stream (s stream)
+ (write-sequence content s))
+ (with-test-file (s *test-file* :class 'file-simple-stream
+ :direction :input :if-does-not-exist :error)
+ (let ((seq (make-array length :element-type '(unsigned-byte 8))))
+ #+nil (read-sequence seq s)
+ #-nil (dotimes (i length)
+ (setf (aref seq i) (read-byte s)))
+ (equalp content seq))))))
+
+(define-test write-read-large-sc-read-seq-3
+ (assert-eql
+ t
+ (let* ((stream (make-instance 'file-simple-stream
+ :filename *test-file* :direction :output
+ :external-format :latin-1
+ :if-exists :overwrite
+ :if-does-not-exist :create))
+ (length (1+ (* 3 (device-buffer-length stream))))
+ (content (make-array length :element-type '(unsigned-byte 8))))
+ (dotimes (i (length content))
+ (setf (aref content i) (random 256)))
+ (with-open-stream (s stream)
+ (write-sequence content s))
+ (with-test-file (s *test-file* :class 'file-simple-stream
+ :direction :input :if-does-not-exist :error)
+ (let ((seq (make-array length :element-type '(unsigned-byte 8))))
+ (read-sequence seq s)
+ (equalp content seq))))))
+
+#+(or)
+(define-test write-read-large-dc-1
;; Do write and read with more data than the buffer will hold
;; (dual-channel simple-stream; we only have socket streams atm)
+ (assert-eql
+ t
(let* ((stream (make-instance 'socket-simple-stream
:remote-host *echo-server*
:remote-port 7
@@ -247,293 +261,309 @@
:initial-element #\x)))
(with-open-stream (s stream)
(string= (prog1 (write-line content s) (finish-output s))
- (read-line s))))
- t)
-
-
-(deftest file-position-1
- ;; Test reading of file-position
- (with-test-file (s *test-file* :class 'file-simple-stream :direction :input
- :initial-content *dumb-string*)
- (file-position s))
- 0)
-
-(deftest file-position-2
- ;; Test reading of file-position
- (with-test-file (s *test-file* :class 'file-simple-stream :direction :input
- :initial-content *dumb-string*)
- (read-byte s)
- (file-position s))
- 1)
-
-(deftest file-position-3
- ;; Test reading of file-position in the presence of unsaved data
- (with-test-file (s *test-file* :class 'file-simple-stream
- :direction :output :if-exists :supersede
- :if-does-not-exist :create)
- (write-byte 50 s)
- (file-position s))
- 1)
-
-(deftest file-position-4
- ;; Test reading of file-position in the presence of unsaved data and
- ;; filled buffer
- (with-test-file (s *test-file* :class 'file-simple-stream :direction :io
- :if-exists :overwrite :if-does-not-exist :create
- :initial-content *dumb-string*)
- (read-byte s) ; fill buffer
- (write-byte 50 s) ; advance file-position
- (file-position s))
- 2)
-
-(deftest file-position-5
- ;; Test file position when opening with :if-exists :append
- (with-test-file (s *test-file* :class 'file-simple-stream :direction :io
- :if-exists :append :if-does-not-exist :create
- :initial-content *dumb-string*)
- (= (file-length s) (file-position s)))
- T)
-
-(deftest write-read-unflushed-sc-1
- ;; Write something into a single-channel stream and read it back
- ;; without explicitly flushing the buffer in-between
- (with-test-file (s *test-file* :class 'file-simple-stream :direction :io
- :if-does-not-exist :create :if-exists :supersede)
- (write-char #\x s)
- (file-position s :start)
- (read-char s))
- #\x)
-
-(deftest write-read-unflushed-sc-2
- ;; Write something into a single-channel stream, try to read back too much
- (handler-case
- (with-test-file (s *test-file* :class 'file-simple-stream
- :direction :io :if-does-not-exist :create
- :if-exists :supersede)
- (write-char #\x s)
- (file-position s :start)
- (read-char s)
- (read-char s)
- nil)
- (end-of-file () t))
- t)
-
-(deftest write-read-unflushed-sc-3
- ;; Test writing in a buffer filled with previous file contents
- (let ((result t))
- (with-test-file (s *test-file* :class 'file-simple-stream :direction :io
- :if-exists :overwrite :if-does-not-exist :create
- :initial-content *dumb-string*)
- (setq result (and result (char= (read-char s) (schar *dumb-string* 0))))
- (setq result (and result (= (file-position s) 1)))
- (let ((pos (file-position s)))
- (write-char #\x s)
- (file-position s pos)
- (setq result (and result (char= (read-char s) #\x)))))
- result)
- t)
-
-(deftest write-read-unflushed-sc-4
- ;; Test flushing of buffers
- (progn
- (with-test-file (s *test-file* :class 'file-simple-stream :direction :io
- :if-exists :overwrite :if-does-not-exist :create
- :initial-content "Foo"
- :delete-afterwards nil)
- (read-char s) ; Fill the buffer.
- (file-position s :start) ; Change existing data.
- (write-char #\X s)
- (file-position s :end) ; Extend file.
- (write-char #\X s))
- (with-test-file (s *test-file* :class 'file-simple-stream
- :direction :input :if-does-not-exist :error)
- (read-line s)))
- "XooX"
- T)
-
-(deftest write-read-append-sc-1
- ;; Test writing in the middle of a stream opened in append mode
- (progn
- (with-test-file (s *test-file* :class 'file-simple-stream :direction :io
- :if-exists :append :if-does-not-exist :create
- :initial-content "Foo"
- :delete-afterwards nil)
- (file-position s :start) ; Jump to beginning.
- (write-char #\X s)
- (file-position s :end) ; Extend file.
- (write-char #\X s))
- (with-test-file (s *test-file* :class 'file-simple-stream
- :direction :input :if-does-not-exist :error)
- (read-line s)))
- "XooX"
- T)
-
-(deftest write-read-mixed-sc-1
- ;; Test read/write-sequence of types string and (unsigned-byte 8)
- (let ((uvector (make-array '(10) :element-type '(unsigned-byte 8)
- :initial-element 64))
- (svector (make-array '(10) :element-type '(signed-byte 8)
- :initial-element -1))
- (result-uvector (make-array '(10) :element-type '(unsigned-byte 8)
- :initial-element 0))
- (result-svector (make-array '(10) :element-type '(signed-byte 8)
- :initial-element 0))
- (result-string (make-string (length *dumb-string*)
- :initial-element #\Space)))
- (with-test-file (s *test-file* :class 'file-simple-stream :direction :io
- :if-exists :overwrite :if-does-not-exist :create
- :delete-afterwards nil)
- (write-sequence svector s)
- (write-sequence uvector s)
- (write-sequence *dumb-string* s))
- (with-test-file (s *test-file* :class 'file-simple-stream
- :direction :input :if-does-not-exist :error
- :delete-afterwards nil)
- (read-sequence result-svector s)
- (read-sequence result-uvector s)
- (read-sequence result-string s))
- (and (string= *dumb-string* result-string)
- (equalp uvector result-uvector)
- (equalp svector result-svector)))
- T)
-
-(deftest create-read-mapped-file-read-seq-1
- ;; Read data via a mapped-file-simple-stream object using
- ;; read-sequence.
- (let ((result t))
- (with-test-file (s *test-file* :class 'mapped-file-simple-stream
- :direction :input :if-does-not-exist :error
- :initial-content *dumb-string*)
- (let ((seq (make-string (length *dumb-string*))))
- (read-sequence seq s)
- (setf result (and result (string= seq *dumb-string*)))))
- result)
- t)
-
-(deftest create-read-mapped-file-read-seq-2
- ;; Read data via a mapped-file-simple-stream object using
- ;; read-sequence.
- (let ((result t))
- (with-test-file (s *test-file* :class 'mapped-file-simple-stream
- :direction :input :if-does-not-exist :error
- :initial-content *dumb-string*)
- (let ((seq (make-string (+ 10 (length *dumb-string*)))))
- (read-sequence seq s)
- (setf result (and result
- (string= seq *dumb-string*
- :end1 (length *dumb-string*))))))
- result)
- t)
+ (read-line s))))))
+
+
+(define-test file-position-1
+ ;; Test reading of file-position
+ (assert-eql
+ 0
+ (with-test-file (s *test-file* :class 'file-simple-stream :direction :input
+ :initial-content *dumb-string*)
+ (file-position s))))
+
+(define-test file-position-2
+ ;; Test reading of file-position
+ (assert-eql
+ 1
+ (with-test-file (s *test-file* :class 'file-simple-stream :direction :input
+ :initial-content *dumb-string*)
+ (read-byte s)
+ (file-position s))))
+
+(define-test file-position-3
+ ;; Test reading of file-position in the presence of unsaved data
+ (assert-eql
+ 1
+ (with-test-file (s *test-file* :class 'file-simple-stream
+ :direction :output :if-exists :supersede
+ :if-does-not-exist :create)
+ (write-byte 50 s)
+ (file-position s))))
+
+(define-test file-position-4
+ ;; Test reading of file-position in the presence of unsaved data and
+ ;; filled buffer
+ (assert-eql
+ 2
+ (with-test-file (s *test-file* :class 'file-simple-stream :direction :io
+ :if-exists :overwrite :if-does-not-exist :create
+ :initial-content *dumb-string*)
+ (read-byte s) ; fill buffer
+ (write-byte 50 s) ; advance file-position
+ (file-position s))))
+
+(define-test file-position-5
+ ;; Test file position when opening with :if-exists :append
+ (assert-eql
+ t
+ (with-test-file (s *test-file* :class 'file-simple-stream :direction :io
+ :if-exists :append :if-does-not-exist :create
+ :initial-content *dumb-string*)
+ (= (file-length s) (file-position s)))))
+
+(define-test write-read-unflushed-sc-1
+ ;; Write something into a single-channel stream and read it back
+ ;; without explicitly flushing the buffer in-between
+ (assert-eql
+ #\x
+ (with-test-file (s *test-file* :class 'file-simple-stream :direction :io
+ :if-does-not-exist :create :if-exists :supersede)
+ (write-char #\x s)
+ (file-position s :start)
+ (read-char s))))
+
+(define-test write-read-unflushed-sc-2
+ ;; Write something into a single-channel stream, try to read back too much
+ (assert-eql
+ t
+ (handler-case
+ (with-test-file (s *test-file* :class 'file-simple-stream
+ :direction :io :if-does-not-exist :create
+ :if-exists :supersede)
+ (write-char #\x s)
+ (file-position s :start)
+ (read-char s)
+ (read-char s)
+ nil)
+ (end-of-file () t))))
+
+(define-test write-read-unflushed-sc-3
+ ;; Test writing in a buffer filled with previous file contents
+ (assert-eql
+ t
+ (let ((result t))
+ (with-test-file (s *test-file* :class 'file-simple-stream :direction :io
+ :if-exists :overwrite :if-does-not-exist :create
+ :initial-content *dumb-string*)
+ (setq result (and result (char= (read-char s) (schar *dumb-string* 0))))
+ (setq result (and result (= (file-position s) 1)))
+ (let ((pos (file-position s)))
+ (write-char #\x s)
+ (file-position s pos)
+ (setq result (and result (char= (read-char s) #\x)))))
+ result)))
+
+(define-test write-read-unflushed-sc-4
+ ;; Test flushing of buffers
+ (assert-equal
+ '("XooX" T)
+ (progn
+ (with-test-file (s *test-file* :class 'file-simple-stream :direction :io
+ :if-exists :overwrite :if-does-not-exist :create
+ :initial-content "Foo"
+ :delete-afterwards nil)
+ (read-char s) ; Fill the buffer.
+ (file-position s :start) ; Change existing data.
+ (write-char #\X s)
+ (file-position s :end) ; Extend file.
+ (write-char #\X s))
+ (with-test-file (s *test-file* :class 'file-simple-stream
+ :direction :input :if-does-not-exist :error)
+ (multiple-value-list (read-line s))))))
+
+(define-test write-read-append-sc-1
+ ;; Test writing in the middle of a stream opened in append mode
+ (assert-equal
+ '("XooX" T)
+ (progn
+ (with-test-file (s *test-file* :class 'file-simple-stream :direction :io
+ :if-exists :append :if-does-not-exist :create
+ :initial-content "Foo"
+ :delete-afterwards nil)
+ (file-position s :start) ; Jump to beginning.
+ (write-char #\X s)
+ (file-position s :end) ; Extend file.
+ (write-char #\X s))
+ (with-test-file (s *test-file* :class 'file-simple-stream
+ :direction :input :if-does-not-exist :error)
+ (multiple-value-list (read-line s))))))
+
+(define-test write-read-mixed-sc-1
+ ;; Test read/write-sequence of types string and (unsigned-byte 8)
+ (assert-eql
+ t
+ (let ((uvector (make-array '(10) :element-type '(unsigned-byte 8)
+ :initial-element 64))
+ (svector (make-array '(10) :element-type '(signed-byte 8)
+ :initial-element -1))
+ (result-uvector (make-array '(10) :element-type '(unsigned-byte 8)
+ :initial-element 0))
+ (result-svector (make-array '(10) :element-type '(signed-byte 8)
+ :initial-element 0))
+ (result-string (make-string (length *dumb-string*)
+ :initial-element #\Space)))
+ (with-test-file (s *test-file* :class 'file-simple-stream :direction :io
+ :if-exists :overwrite :if-does-not-exist :create
+ :delete-afterwards nil)
+ (write-sequence svector s)
+ (write-sequence uvector s)
+ (write-sequence *dumb-string* s))
+ (with-test-file (s *test-file* :class 'file-simple-stream
+ :direction :input :if-does-not-exist :error
+ :delete-afterwards nil)
+ (read-sequence result-svector s)
+ (read-sequence result-uvector s)
+ (read-sequence result-string s))
+ (and (string= *dumb-string* result-string)
+ (equalp uvector result-uvector)
+ (equalp svector result-svector)))))
+
+(define-test create-read-mapped-file-read-seq-1
+ ;; Read data via a mapped-file-simple-stream object using
+ ;; read-sequence.
+ (assert-eql
+ t
+ (let ((result t))
+ (with-test-file (s *test-file* :class 'mapped-file-simple-stream
+ :direction :input :if-does-not-exist :error
+ :initial-content *dumb-string*)
+ (let ((seq (make-string (length *dumb-string*))))
+ (read-sequence seq s)
+ (setf result (and result (string= seq *dumb-string*)))))
+ result)))
+
+(define-test create-read-mapped-file-read-seq-2
+ ;; Read data via a mapped-file-simple-stream object using
+ ;; read-sequence.
+ (assert-eql
+ t
+ (let ((result t))
+ (with-test-file (s *test-file* :class 'mapped-file-simple-stream
+ :direction :input :if-does-not-exist :error
+ :initial-content *dumb-string*)
+ (let ((seq (make-string (+ 10 (length *dumb-string*)))))
+ (read-sequence seq s)
+ (setf result (and result
+ (string= seq *dumb-string*
+ :end1 (length *dumb-string*))))))
+ result)))
;;; From Lynn Quam, cmucl-imp, 2004-12-04: After doing a READ-VECTOR,
;;; FILE-POSITION returns the wrong value.
-(deftest file-position-6
- ;; Test the file-position is right.
- (with-open-file (st1 "/etc/passwd" :class 'stream:file-simple-stream)
- (with-open-file (st2 "/etc/passwd" :element-type '(unsigned-byte 8))
- (let* ((buf1 (make-array 100 :element-type '(unsigned-byte 8)))
- (buf2 (make-array 100 :element-type '(unsigned-byte 8)))
- (n1 (stream:read-vector buf1 st1))
- (n2 (read-sequence buf2 st2)))
- (list n1 (file-position st1)
- n2 (file-position st2)))))
- (100 100 100 100)
- )
+(lisp-unit:define-test file-position-6
+ ;; Test the file-position is right.
+ (assert-equal
+ '(100 100 100 100)
+ (with-open-file (st1 "/etc/passwd" :class 'stream:file-simple-stream)
+ (with-open-file (st2 "/etc/passwd" :element-type '(unsigned-byte 8))
+ (let* ((buf1 (make-array 100 :element-type '(unsigned-byte 8)))
+ (buf2 (make-array 100 :element-type '(unsigned-byte 8)))
+ (n1 (stream:read-vector buf1 st1))
+ (n2 (read-sequence buf2 st2)))
+ (list n1 (file-position st1)
+ n2 (file-position st2)))))))
;;; From Madhu, cmucl-imp, 2006-12-16
-(deftest file-position-7
- (with-open-file (st1 "/etc/passwd" :mapped t :class 'stream:file-simple-stream)
- (let* ((posn1 (file-position st1))
- (line1 (read-line st1))
- (posn2 (file-position st1)))
- (list posn1 (= posn2 (1+ (length line1))))))
- (0 t))
-
-(deftest file-position-8
- (with-open-file (st1 "/etc/passwd" :mapped t :class 'stream:file-simple-stream)
- (let* ((posn1 (file-position st1))
- (c1 (read-char st1))
- (posn2 (file-position st1)))
- (list posn1 posn2)))
- (0 1))
+(define-test file-position-7
+ (assert-equal
+ '(0 t)
+ (with-open-file (st1 "/etc/passwd" :mapped t :class 'stream:file-simple-stream)
+ (let* ((posn1 (file-position st1))
+ (line1 (read-line st1))
+ (posn2 (file-position st1)))
+ (list posn1 (= posn2 (1+ (length line1))))))))
+
+(define-test file-position-8
+ (assert-equal
+ '(0 1)
+ (with-open-file (st1 "/etc/passwd" :mapped t :class 'stream:file-simple-stream)
+ (let* ((posn1 (file-position st1))
+ (c1 (read-char st1))
+ (posn2 (file-position st1)))
+ (list posn1 posn2)))))
;;; Some specific tests for full unicode support.
#+unicode
-(deftest unicode-read-1
- ;; Tests if reading unicode surrogates works
- (let ((string (map 'string #'code-char '(#xd800 #xdc00))))
- (with-open-file (s *test-file*
- :direction :output
- :if-exists :supersede
- :if-does-not-exist :create
- :external-format :utf8)
- (write-string string s))
- (with-open-file (s *test-file* :class 'file-simple-stream
- :direction :input
- :if-does-not-exist :error
- :external-format :utf8)
- (let ((seq (read-line s)))
- (string= string seq))))
- t)
+(define-test unicode-read-1
+ ;; Tests if reading unicode surrogates works
+ (assert-eql
+ t
+ (let ((string (map 'string #'code-char '(#xd800 #xdc00))))
+ (with-open-file (s *test-file*
+ :direction :output
+ :if-exists :supersede
+ :if-does-not-exist :create
+ :external-format :utf8)
+ (write-string string s))
+ (with-open-file (s *test-file* :class 'file-simple-stream
+ :direction :input
+ :if-does-not-exist :error
+ :external-format :utf8)
+ (let ((seq (read-line s)))
+ (string= string seq))))))
#+unicode
-(deftest unicode-read-large-1
- ;; Tests if reading unicode surrogates works
- (let ((string (concatenate 'string
- (map 'string #'code-char '(#xd800 #xdc00))
- (make-string 5000 :initial-element #\X))))
- (with-open-file (s *test-file*
- :direction :output
- :if-exists :supersede
- :if-does-not-exist :create
- :external-format :utf8)
- (write-string string s))
- (with-open-file (s *test-file* :class 'file-simple-stream
- :direction :input
- :if-does-not-exist :error
- :external-format :utf8)
- (let ((seq (read-line s)))
- (string= string seq))))
- t)
+(define-test unicode-read-large-1
+ ;; Tests if reading unicode surrogates works
+ (assert-eql
+ t
+ (let ((string (concatenate 'string
+ (map 'string #'code-char '(#xd800 #xdc00))
+ (make-string 5000 :initial-element #\X))))
+ (with-open-file (s *test-file*
+ :direction :output
+ :if-exists :supersede
+ :if-does-not-exist :create
+ :external-format :utf8)
+ (write-string string s))
+ (with-open-file (s *test-file* :class 'file-simple-stream
+ :direction :input
+ :if-does-not-exist :error
+ :external-format :utf8)
+ (let ((seq (read-line s)))
+ (string= string seq))))))
#+unicode
-(deftest unicode-write-1
- ;; Tests if writing unicode surrogates work
- (let ((string (map 'string #'code-char '(#xd800 #xdc00))))
- (with-open-file (s *test-file*
- :class 'file-simple-stream
- :direction :output
- :if-exists :supersede
- :if-does-not-exist :create
- :external-format :utf8)
- (write-string string s))
- (with-open-file (s *test-file*
- :direction :input
- :if-does-not-exist :error
- :external-format :utf8)
- (let ((seq (read-line s)))
- (string= string seq))))
- t)
+(define-test unicode-write-1
+ ;; Tests if writing unicode surrogates work
+ (assert-eql
+ t
+ (let ((string (map 'string #'code-char '(#xd800 #xdc00))))
+ (with-open-file (s *test-file*
+ :class 'file-simple-stream
+ :direction :output
+ :if-exists :supersede
+ :if-does-not-exist :create
+ :external-format :utf8)
+ (write-string string s))
+ (with-open-file (s *test-file*
+ :direction :input
+ :if-does-not-exist :error
+ :external-format :utf8)
+ (let ((seq (read-line s)))
+ (string= string seq))))))
#+unicode
-(deftest unicode-write-large-1
- ;; Tests if writing unicode surrogates work
- (let ((string (concatenate 'string
- (map 'string #'code-char '(#xd800 #xdc00))
- (make-string 5000 :initial-element #\X))))
- (with-open-file (s *test-file*
- :class 'file-simple-stream
- :direction :output
- :if-exists :supersede
- :if-does-not-exist :create
- :external-format :utf8)
- (write-string string s))
- (with-open-file (s *test-file*
- :direction :input
- :if-does-not-exist :error
- :external-format :utf8)
- (let ((seq (read-line s)))
- (string= string seq))))
- t)
+(define-test unicode-write-large-1
+ ;; Tests if writing unicode surrogates work
+ (assert-eql
+ t
+ (let ((string (concatenate 'string
+ (map 'string #'code-char '(#xd800 #xdc00))
+ (make-string 5000 :initial-element #\X))))
+ (with-open-file (s *test-file*
+ :class 'file-simple-stream
+ :direction :output
+ :if-exists :supersede
+ :if-does-not-exist :create
+ :external-format :utf8)
+ (write-string string s))
+ (with-open-file (s *test-file*
+ :direction :input
+ :if-does-not-exist :error
+ :external-format :utf8)
+ (let ((seq (read-line s)))
+ (string= string seq))))))
commit 866c8bcf2fc93eb6dacd5707ff0e4cacea72734b
Author: Raymond Toy <toy.raymond at gmail.com>
Date: Tue Jan 7 19:48:15 2014 -0800
Copy src/pcl/simple-streams/rt/simple-streams-tests.lisp to
tests/simple-streams.lisp. Unchanged.
diff --git a/tests/simple-streams.lisp b/tests/simple-streams.lisp
new file mode 100644
index 0000000..7a9a24f
--- /dev/null
+++ b/tests/simple-streams.lisp
@@ -0,0 +1,539 @@
+;;;; -*- lisp -*-
+
+(require :simple-streams)
+
+(defpackage simple-streams-test
+ (:use #:common-lisp #:stream #:rt))
+
+
+(in-package #:simple-streams-test)
+
+(defparameter *dumb-string*
+ "This file was created by simple-stream-tests.lisp. Nothing to see here, move along.")
+
+(defparameter *test-path*
+ (merge-pathnames (make-pathname :name :unspecific :type :unspecific
+ :version :unspecific)
+ *load-truename*)
+ "Directory for temporary test files.")
+
+(defparameter *test-file*
+ (merge-pathnames #p"test-data.tmp" *test-path*))
+
+(defparameter *echo-server* "127.0.0.1")
+
+(eval-when (:load-toplevel)
+ (ensure-directories-exist *test-path* :verbose t))
+
+;;; Non-destructive functional analog of REMF
+(defun remove-key (key list)
+ (loop for (current-key val . rest) on list by #'cddr
+ until (eql current-key key)
+ collect current-key into result
+ collect val into result
+ finally (return (nconc result rest))))
+
+(defun create-test-file (&key (filename *test-file*) (content *dumb-string*))
+ (with-open-file (s filename :direction :output
+ :external-format :latin-1
+ :if-does-not-exist :create
+ :if-exists :supersede)
+ (write-sequence content s)))
+
+(defun remove-test-file (&key (filename *test-file*))
+ (delete-file filename))
+
+(defmacro with-test-file ((stream file &rest open-arguments
+ &key (delete-afterwards t)
+ initial-content
+ &allow-other-keys)
+ &body body)
+ (setq open-arguments (remove-key :delete-afterwards open-arguments))
+ (setq open-arguments (remove-key :initial-content open-arguments))
+ (if initial-content
+ (let ((create-file-stream (gensym)))
+ `(progn
+ (with-open-file (,create-file-stream ,file :direction :output
+ :external-format :latin-1
+ :if-exists :supersede
+ :if-does-not-exist :create)
+ (write-sequence ,initial-content ,create-file-stream))
+ (unwind-protect
+ (with-open-file (,stream ,file , at open-arguments
+ :external-format :latin-1)
+ (progn , at body))
+ ,(when delete-afterwards `(ignore-errors (delete-file ,file))))))
+ `(unwind-protect
+ (with-open-file (,stream ,file , at open-arguments
+ :external-format :latin-1)
+ (progn , at body))
+ ,(when delete-afterwards `(ignore-errors (delete-file ,file))))))
+
+(deftest create-file-1
+ ;; Create a file-simple-stream, write data.
+ (prog1
+ (with-open-stream (s (make-instance 'file-simple-stream
+ :filename *test-file*
+ :direction :output
+ :external-format :latin-1
+ :if-exists :overwrite
+ :if-does-not-exist :create))
+ (string= (write-string *dumb-string* s) *dumb-string*))
+ (delete-file *test-file*))
+ t)
+
+(deftest create-file-2
+ ;; Create a file-simple-stream via :class argument to open, write data.
+ (with-test-file (s *test-file* :class 'file-simple-stream
+ :direction :output :if-exists :overwrite
+ :if-does-not-exist :create)
+ (string= (write-string *dumb-string* s) *dumb-string*))
+ t)
+
+(deftest create-read-file-1
+ ;; Via file-simple-stream objects, write and then re-read data.
+ (let ((result t))
+ (with-test-file (s *test-file* :class 'file-simple-stream
+ :direction :output :if-exists :overwrite
+ :if-does-not-exist :create :delete-afterwards nil)
+ (write-line *dumb-string* s)
+ (setf result (and result (string= (write-string *dumb-string* s)
+ *dumb-string*))))
+
+ (with-test-file (s *test-file* :class 'file-simple-stream
+ :direction :input :if-does-not-exist :error)
+ ;; Check first line
+ (multiple-value-bind (string missing-newline-p)
+ (read-line s)
+ (setf result (and result (string= string *dumb-string*)
+ (not missing-newline-p))))
+ ;; Check second line
+ (multiple-value-bind (string missing-newline-p)
+ (read-line s)
+ (setf result (and result (string= string *dumb-string*)
+ missing-newline-p))))
+ result)
+ t)
+
+(deftest create-read-mapped-file-1
+ ;; Read data via a mapped-file-simple-stream object.
+ (let ((result t))
+ (with-test-file (s *test-file* :class 'mapped-file-simple-stream
+ :direction :input :if-does-not-exist :error
+ :initial-content *dumb-string*)
+ (setf result (and result (string= (read-line s) *dumb-string*))))
+ result)
+ t)
+
+(deftest write-read-inet
+ ;; Open a socket-simple-stream to the echo service and test if we
+ ;; get it echoed back. Obviously fails if the echo service isn't
+ ;; enabled.
+ (with-open-stream (s (make-instance 'socket-simple-stream
+ :remote-host *echo-server*
+ :remote-port 7
+ :direction :io))
+ (string= (prog1
+ (write-line "Got it!" s)
+ (finish-output s))
+ (read-line s)))
+ t)
+
+(deftest write-read-large-sc-1
+ ;; Do write and read with more data than the buffer will hold
+ ;; (single-channel simple-stream)
+ (let* ((stream (make-instance 'file-simple-stream
+ :filename *test-file* :direction :output
+ :external-format :latin-1
+ :if-exists :overwrite
+ :if-does-not-exist :create))
+ (content (make-string (1+ (device-buffer-length stream))
+ :initial-element #\x)))
+ (with-open-stream (s stream)
+ (write-string content s))
+ (with-test-file (s *test-file* :class 'file-simple-stream
+ :direction :input :if-does-not-exist :error)
+ (string= content (read-line s))))
+ t)
+
+(deftest write-read-large-sc-2
+ (let* ((stream (make-instance 'file-simple-stream
+ :filename *test-file* :direction :output
+ :external-format :latin-1
+ :if-exists :overwrite
+ :if-does-not-exist :create))
+ (length (1+ (* 3 (device-buffer-length stream))))
+ (content (make-string length)))
+ (dotimes (i (length content))
+ (setf (aref content i) (code-char (random 256))))
+ (with-open-stream (s stream)
+ (write-string content s))
+ (with-test-file (s *test-file* :class 'file-simple-stream
+ :direction :input :if-does-not-exist :error)
+ (let ((seq (make-string length)))
+ #+nil (read-sequence seq s)
+ #-nil (dotimes (i length)
+ (setf (char seq i) (read-char s)))
+ (string= content seq))))
+ t)
+
+(deftest write-read-large-sc-read-seq-2
+ (let* ((stream (make-instance 'file-simple-stream
+ :filename *test-file* :direction :output
+ :external-format :latin-1
+ :if-exists :overwrite
+ :if-does-not-exist :create))
+ (length (1+ (* 3 (device-buffer-length stream))))
+ (content (make-string length)))
+ (dotimes (i (length content))
+ (setf (aref content i) (code-char (random 256))))
+ (with-open-stream (s stream)
+ (write-string content s))
+ (with-test-file (s *test-file* :class 'file-simple-stream
+ :direction :input :if-does-not-exist :error)
+ (let ((seq (make-string length)))
+ (read-sequence seq s)
+ (string= content seq))))
+ t)
+
+(deftest write-read-large-sc-3
+ (let* ((stream (make-instance 'file-simple-stream
+ :filename *test-file* :direction :output
+ :external-format :latin-1
+ :if-exists :overwrite
+ :if-does-not-exist :create))
+ (length (1+ (* 3 (device-buffer-length stream))))
+ (content (make-array length :element-type '(unsigned-byte 8))))
+ (dotimes (i (length content))
+ (setf (aref content i) (random 256)))
+ (with-open-stream (s stream)
+ (write-sequence content s))
+ (with-test-file (s *test-file* :class 'file-simple-stream
+ :direction :input :if-does-not-exist :error)
+ (let ((seq (make-array length :element-type '(unsigned-byte 8))))
+ #+nil (read-sequence seq s)
+ #-nil (dotimes (i length)
+ (setf (aref seq i) (read-byte s)))
+ (equalp content seq))))
+ t)
+
+(deftest write-read-large-sc-read-seq-3
+ (let* ((stream (make-instance 'file-simple-stream
+ :filename *test-file* :direction :output
+ :external-format :latin-1
+ :if-exists :overwrite
+ :if-does-not-exist :create))
+ (length (1+ (* 3 (device-buffer-length stream))))
+ (content (make-array length :element-type '(unsigned-byte 8))))
+ (dotimes (i (length content))
+ (setf (aref content i) (random 256)))
+ (with-open-stream (s stream)
+ (write-sequence content s))
+ (with-test-file (s *test-file* :class 'file-simple-stream
+ :direction :input :if-does-not-exist :error)
+ (let ((seq (make-array length :element-type '(unsigned-byte 8))))
+ (read-sequence seq s)
+ (equalp content seq))))
+ t)
+
+(deftest write-read-large-dc-1
+ ;; Do write and read with more data than the buffer will hold
+ ;; (dual-channel simple-stream; we only have socket streams atm)
+ (let* ((stream (make-instance 'socket-simple-stream
+ :remote-host *echo-server*
+ :remote-port 7
+ :direction :io))
+ (content (make-string (1+ (device-buffer-length stream))
+ :initial-element #\x)))
+ (with-open-stream (s stream)
+ (string= (prog1 (write-line content s) (finish-output s))
+ (read-line s))))
+ t)
+
+
+(deftest file-position-1
+ ;; Test reading of file-position
+ (with-test-file (s *test-file* :class 'file-simple-stream :direction :input
+ :initial-content *dumb-string*)
+ (file-position s))
+ 0)
+
+(deftest file-position-2
+ ;; Test reading of file-position
+ (with-test-file (s *test-file* :class 'file-simple-stream :direction :input
+ :initial-content *dumb-string*)
+ (read-byte s)
+ (file-position s))
+ 1)
+
+(deftest file-position-3
+ ;; Test reading of file-position in the presence of unsaved data
+ (with-test-file (s *test-file* :class 'file-simple-stream
+ :direction :output :if-exists :supersede
+ :if-does-not-exist :create)
+ (write-byte 50 s)
+ (file-position s))
+ 1)
+
+(deftest file-position-4
+ ;; Test reading of file-position in the presence of unsaved data and
+ ;; filled buffer
+ (with-test-file (s *test-file* :class 'file-simple-stream :direction :io
+ :if-exists :overwrite :if-does-not-exist :create
+ :initial-content *dumb-string*)
+ (read-byte s) ; fill buffer
+ (write-byte 50 s) ; advance file-position
+ (file-position s))
+ 2)
+
+(deftest file-position-5
+ ;; Test file position when opening with :if-exists :append
+ (with-test-file (s *test-file* :class 'file-simple-stream :direction :io
+ :if-exists :append :if-does-not-exist :create
+ :initial-content *dumb-string*)
+ (= (file-length s) (file-position s)))
+ T)
+
+(deftest write-read-unflushed-sc-1
+ ;; Write something into a single-channel stream and read it back
+ ;; without explicitly flushing the buffer in-between
+ (with-test-file (s *test-file* :class 'file-simple-stream :direction :io
+ :if-does-not-exist :create :if-exists :supersede)
+ (write-char #\x s)
+ (file-position s :start)
+ (read-char s))
+ #\x)
+
+(deftest write-read-unflushed-sc-2
+ ;; Write something into a single-channel stream, try to read back too much
+ (handler-case
+ (with-test-file (s *test-file* :class 'file-simple-stream
+ :direction :io :if-does-not-exist :create
+ :if-exists :supersede)
+ (write-char #\x s)
+ (file-position s :start)
+ (read-char s)
+ (read-char s)
+ nil)
+ (end-of-file () t))
+ t)
+
+(deftest write-read-unflushed-sc-3
+ ;; Test writing in a buffer filled with previous file contents
+ (let ((result t))
+ (with-test-file (s *test-file* :class 'file-simple-stream :direction :io
+ :if-exists :overwrite :if-does-not-exist :create
+ :initial-content *dumb-string*)
+ (setq result (and result (char= (read-char s) (schar *dumb-string* 0))))
+ (setq result (and result (= (file-position s) 1)))
+ (let ((pos (file-position s)))
+ (write-char #\x s)
+ (file-position s pos)
+ (setq result (and result (char= (read-char s) #\x)))))
+ result)
+ t)
+
+(deftest write-read-unflushed-sc-4
+ ;; Test flushing of buffers
+ (progn
+ (with-test-file (s *test-file* :class 'file-simple-stream :direction :io
+ :if-exists :overwrite :if-does-not-exist :create
+ :initial-content "Foo"
+ :delete-afterwards nil)
+ (read-char s) ; Fill the buffer.
+ (file-position s :start) ; Change existing data.
+ (write-char #\X s)
+ (file-position s :end) ; Extend file.
+ (write-char #\X s))
+ (with-test-file (s *test-file* :class 'file-simple-stream
+ :direction :input :if-does-not-exist :error)
+ (read-line s)))
+ "XooX"
+ T)
+
+(deftest write-read-append-sc-1
+ ;; Test writing in the middle of a stream opened in append mode
+ (progn
+ (with-test-file (s *test-file* :class 'file-simple-stream :direction :io
+ :if-exists :append :if-does-not-exist :create
+ :initial-content "Foo"
+ :delete-afterwards nil)
+ (file-position s :start) ; Jump to beginning.
+ (write-char #\X s)
+ (file-position s :end) ; Extend file.
+ (write-char #\X s))
+ (with-test-file (s *test-file* :class 'file-simple-stream
+ :direction :input :if-does-not-exist :error)
+ (read-line s)))
+ "XooX"
+ T)
+
+(deftest write-read-mixed-sc-1
+ ;; Test read/write-sequence of types string and (unsigned-byte 8)
+ (let ((uvector (make-array '(10) :element-type '(unsigned-byte 8)
+ :initial-element 64))
+ (svector (make-array '(10) :element-type '(signed-byte 8)
+ :initial-element -1))
+ (result-uvector (make-array '(10) :element-type '(unsigned-byte 8)
+ :initial-element 0))
+ (result-svector (make-array '(10) :element-type '(signed-byte 8)
+ :initial-element 0))
+ (result-string (make-string (length *dumb-string*)
+ :initial-element #\Space)))
+ (with-test-file (s *test-file* :class 'file-simple-stream :direction :io
+ :if-exists :overwrite :if-does-not-exist :create
+ :delete-afterwards nil)
+ (write-sequence svector s)
+ (write-sequence uvector s)
+ (write-sequence *dumb-string* s))
+ (with-test-file (s *test-file* :class 'file-simple-stream
+ :direction :input :if-does-not-exist :error
+ :delete-afterwards nil)
+ (read-sequence result-svector s)
+ (read-sequence result-uvector s)
+ (read-sequence result-string s))
+ (and (string= *dumb-string* result-string)
+ (equalp uvector result-uvector)
+ (equalp svector result-svector)))
+ T)
+
+(deftest create-read-mapped-file-read-seq-1
+ ;; Read data via a mapped-file-simple-stream object using
+ ;; read-sequence.
+ (let ((result t))
+ (with-test-file (s *test-file* :class 'mapped-file-simple-stream
+ :direction :input :if-does-not-exist :error
+ :initial-content *dumb-string*)
+ (let ((seq (make-string (length *dumb-string*))))
+ (read-sequence seq s)
+ (setf result (and result (string= seq *dumb-string*)))))
+ result)
+ t)
+
+(deftest create-read-mapped-file-read-seq-2
+ ;; Read data via a mapped-file-simple-stream object using
+ ;; read-sequence.
+ (let ((result t))
+ (with-test-file (s *test-file* :class 'mapped-file-simple-stream
+ :direction :input :if-does-not-exist :error
+ :initial-content *dumb-string*)
+ (let ((seq (make-string (+ 10 (length *dumb-string*)))))
+ (read-sequence seq s)
+ (setf result (and result
+ (string= seq *dumb-string*
+ :end1 (length *dumb-string*))))))
+ result)
+ t)
+
+
+;;; From Lynn Quam, cmucl-imp, 2004-12-04: After doing a READ-VECTOR,
+;;; FILE-POSITION returns the wrong value.
+
+(deftest file-position-6
+ ;; Test the file-position is right.
+ (with-open-file (st1 "/etc/passwd" :class 'stream:file-simple-stream)
+ (with-open-file (st2 "/etc/passwd" :element-type '(unsigned-byte 8))
+ (let* ((buf1 (make-array 100 :element-type '(unsigned-byte 8)))
+ (buf2 (make-array 100 :element-type '(unsigned-byte 8)))
+ (n1 (stream:read-vector buf1 st1))
+ (n2 (read-sequence buf2 st2)))
+ (list n1 (file-position st1)
+ n2 (file-position st2)))))
+ (100 100 100 100)
+ )
+
+;;; From Madhu, cmucl-imp, 2006-12-16
+(deftest file-position-7
+ (with-open-file (st1 "/etc/passwd" :mapped t :class 'stream:file-simple-stream)
+ (let* ((posn1 (file-position st1))
+ (line1 (read-line st1))
+ (posn2 (file-position st1)))
+ (list posn1 (= posn2 (1+ (length line1))))))
+ (0 t))
+
+(deftest file-position-8
+ (with-open-file (st1 "/etc/passwd" :mapped t :class 'stream:file-simple-stream)
+ (let* ((posn1 (file-position st1))
+ (c1 (read-char st1))
+ (posn2 (file-position st1)))
+ (list posn1 posn2)))
+ (0 1))
+
+;;; Some specific tests for full unicode support.
+#+unicode
+(deftest unicode-read-1
+ ;; Tests if reading unicode surrogates works
+ (let ((string (map 'string #'code-char '(#xd800 #xdc00))))
+ (with-open-file (s *test-file*
+ :direction :output
+ :if-exists :supersede
+ :if-does-not-exist :create
+ :external-format :utf8)
+ (write-string string s))
+ (with-open-file (s *test-file* :class 'file-simple-stream
+ :direction :input
+ :if-does-not-exist :error
+ :external-format :utf8)
+ (let ((seq (read-line s)))
+ (string= string seq))))
+ t)
+
+#+unicode
+(deftest unicode-read-large-1
+ ;; Tests if reading unicode surrogates works
+ (let ((string (concatenate 'string
+ (map 'string #'code-char '(#xd800 #xdc00))
+ (make-string 5000 :initial-element #\X))))
+ (with-open-file (s *test-file*
+ :direction :output
+ :if-exists :supersede
+ :if-does-not-exist :create
+ :external-format :utf8)
+ (write-string string s))
+ (with-open-file (s *test-file* :class 'file-simple-stream
+ :direction :input
+ :if-does-not-exist :error
+ :external-format :utf8)
+ (let ((seq (read-line s)))
+ (string= string seq))))
+ t)
+
+#+unicode
+(deftest unicode-write-1
+ ;; Tests if writing unicode surrogates work
+ (let ((string (map 'string #'code-char '(#xd800 #xdc00))))
+ (with-open-file (s *test-file*
+ :class 'file-simple-stream
+ :direction :output
+ :if-exists :supersede
+ :if-does-not-exist :create
+ :external-format :utf8)
+ (write-string string s))
+ (with-open-file (s *test-file*
+ :direction :input
+ :if-does-not-exist :error
+ :external-format :utf8)
+ (let ((seq (read-line s)))
+ (string= string seq))))
+ t)
+
+#+unicode
+(deftest unicode-write-large-1
+ ;; Tests if writing unicode surrogates work
+ (let ((string (concatenate 'string
+ (map 'string #'code-char '(#xd800 #xdc00))
+ (make-string 5000 :initial-element #\X))))
+ (with-open-file (s *test-file*
+ :class 'file-simple-stream
+ :direction :output
+ :if-exists :supersede
+ :if-does-not-exist :create
+ :external-format :utf8)
+ (write-string string s))
+ (with-open-file (s *test-file*
+ :direction :input
+ :if-does-not-exist :error
+ :external-format :utf8)
+ (let ((seq (read-line s)))
+ (string= string seq))))
+ t)
-----------------------------------------------------------------------
Summary of changes:
tests/simple-streams.lisp | 569 +++++++++++++++++++++++++++++++++++++++++++++
1 file changed, 569 insertions(+)
create mode 100644 tests/simple-streams.lisp
hooks/post-receive
--
CMU Common Lisp
More information about the cmucl-cvs
mailing list