"This file was created by simple-stream-tests.lisp. Nothing to see here, move along.")
(defparameter *test-path*
- (merge-pathnames (make-pathname :name nil :type nil :version nil)
+ (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*))
+
(eval-when (:load-toplevel) (ensure-directories-exist *test-path* :verbose t))
;;; Non-destructive functional analog of REMF
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
+ :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
(progn ,@body))
,(when delete-afterwards `(ignore-errors (delete-file ,file))))))
+(deftest non-existent-class
+ (handler-case
+ (with-test-file (s *test-file* :class 'non-existent-stream)
+ nil)
+ ;; find-class will raise a simple-error
+ (simple-error (c) (search "There is no class" (simple-condition-format-control c))))
+ 0)
+
+(deftest non-stream-class
+ (handler-case
+ (with-test-file (s *test-file* :class 'standard-class)
+ nil)
+ ;; Will fall through sb-simple-streams:open as it is no stream class.
+ (simple-error (c) (search "Don't know how to handle" (simple-condition-format-control c))))
+ 0)
(deftest create-file-1
- ;; Create a file-simple-stream, write data.
- (let* ((file (merge-pathnames #p"test-data.txt" *test-path*)))
+ ;; Create a file-simple-stream, write data.
(prog1
(with-open-stream (s (make-instance 'file-simple-stream
- :filename file
+ :filename *test-file*
:direction :output
:if-exists :overwrite
:if-does-not-exist :create))
(string= (write-string *dumb-string* s) *dumb-string*))
- (delete-file file)))
+ (delete-file *test-file*))
t)
(deftest create-file-2
- ;; Create a file-simple-stream via :class argument to open, write data.
- (let ((file (merge-pathnames #p"test-data.txt" *test-path*)))
- (with-test-file (s file :class 'file-simple-stream :direction :output
- :if-exists :overwrite :if-does-not-exist :create)
- (string= (write-string *dumb-string* s) *dumb-string*)))
+ ;; 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)
- (file (merge-pathnames #p"test-data.txt" *test-path*)))
- (with-test-file (s file :class 'file-simple-stream :direction :output
- :if-exists :overwrite :if-does-not-exist :create
- :delete-afterwards nil)
+ (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 file :class 'file-simple-stream
+ (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)
(deftest create-read-mapped-file-1
;; Read data via a mapped-file-simple-stream object.
- (let ((result t)
- (file (merge-pathnames #p"test-data.txt" *test-path*)))
- (with-test-file (s file :class 'mapped-file-simple-stream
+ (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*))))
(deftest write-read-inet
(handler-case
(with-open-stream (s (make-instance 'socket-simple-stream
- :remote-host #(127 0 0 1)
- :remote-port 7))
- (string= (prog1 (write-line "Got it!" s) (finish-output s))
- (read-line s)))
- (sb-bsd-sockets::connection-refused-error () t))
+ :remote-host #(127 0 0 1)
+ :remote-port 7
+ :direction :io))
+ (string= (prog1 (write-line "Got it!" s) (finish-output s))
+ (read-line s)))
+ ;; Fail gracefully if echo isn't activated on the system
+ (sb-bsd-sockets::connection-refused-error () t)
+ ;; Timeout may occur on the restricted systems (e.g. FreeBSD
+ ;; with jail(8) or blackhole(4) is used).
+ (sb-bsd-sockets::operation-timeout-error () t))
t)
(deftest write-read-large-sc-1
;; Do write and read with more data than the buffer will hold
;; (single-channel simple-stream)
- (let* ((file (merge-pathnames #p"test-data.txt" *test-path*))
- (stream (make-instance 'file-simple-stream
- :filename file :direction :output
+ (let* ((stream (make-instance 'file-simple-stream
+ :filename *test-file* :direction :output
: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 file :class 'file-simple-stream
+ (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* ((file (merge-pathnames #p"test-data.txt" *test-path*))
- (stream (make-instance 'file-simple-stream
- :filename file :direction :output
+ (let* ((stream (make-instance 'file-simple-stream
+ :filename *test-file* :direction :output
:if-exists :overwrite
:if-does-not-exist :create))
(length (1+ (* 3 (device-buffer-length stream))))
(setf (aref content i) (code-char (random 256))))
(with-open-stream (s stream)
(write-string content s))
- (with-test-file (s file :class 'file-simple-stream
+ (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)
t)
(deftest write-read-large-sc-3
- (let* ((file (merge-pathnames #p"test-data.txt" *test-path*))
- (stream (make-instance 'file-simple-stream
- :filename file :direction :output
+ (let* ((stream (make-instance 'file-simple-stream
+ :filename *test-file* :direction :output
:if-exists :overwrite
:if-does-not-exist :create))
(length (1+ (* 3 (device-buffer-length stream))))
(setf (aref content i) (random 256)))
(with-open-stream (s stream)
(write-sequence content s))
- (with-test-file (s file :class 'file-simple-stream
+ (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)
(handler-case
(let* ((stream (make-instance 'socket-simple-stream
:remote-host #(127 0 0 1)
- :remote-port 7))
+ :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))))
- (sb-bsd-sockets::connection-refused-error () t))
+ ;; Fail gracefully if echo isn't activated on the system
+ (sb-bsd-sockets::connection-refused-error () t)
+ ;; Timeout may occur on the restricted systems (e.g. FreeBSD
+ ;; with jail(8) or blackhole(4) is used).
+ (sb-bsd-sockets::operation-timeout-error () t))
t)
(deftest file-position-1
- ;; Test reading of file-position
- (let* ((file (merge-pathnames #p"test-data.txt" *test-path*)))
- (with-test-file (s file :class 'file-simple-stream :direction :input
+ ;; Test reading of file-position
+ (with-test-file (s *test-file* :class 'file-simple-stream :direction :input
:initial-content *dumb-string*)
- (file-position s)))
+ (file-position s))
0)
-;;; file-position-2 fails ONLY when called with
-;;; (asdf:oos 'asdf:test-op :sb-simple-streams)
-;;; TODO: Find out why
(deftest file-position-2
- ;; Test reading of file-position
- (let* ((file (merge-pathnames #p"test-data.txt" *test-path*)))
- (with-test-file (s file :class 'file-simple-stream :direction :input
+ ;; 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)))
+ (file-position s))
1)
(deftest file-position-3
- ;; Test reading of file-position in the presence of unsaved data
- (let* ((file (merge-pathnames #p"test-data.txt" *test-path*)))
- (with-test-file (s file :class 'file-simple-stream :direction :output
- :if-exists :supersede :if-does-not-exist :create)
+ ;; 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)))
+ (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
- (let ((file (merge-pathnames #p"test-data.txt" *test-path*)))
- (with-test-file (s file :class 'file-simple-stream :direction :io
- :if-exists :append :if-does-not-exist :create
- :initial-content "Foo")
- (= (file-length s) (file-position s))))
+ (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
- (let* ((file (merge-pathnames #p"test-data.txt" *test-path*)))
- (with-test-file (s file :class 'file-simple-stream :direction :io
+ ;; 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)))
+ (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
- (let* ((file (merge-pathnames #p"test-data.txt" *test-path*)))
- (with-test-file (s 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))
+ ;; 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
- (let ((file (merge-pathnames #p"test-data.txt" *test-path*))
- (result t))
- (with-test-file (s file :class 'file-simple-stream :direction :io
+ ;; 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) (char *dumb-string* 0))))
+ (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)
(deftest write-read-unflushed-sc-4
;; Test flushing of buffers
- (let ((file (merge-pathnames #p"test-data.txt" *test-path*)))
- (with-test-file (s file :class 'file-simple-stream :direction :io
+ (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)
(write-char #\X s)
(file-position s :end) ; Extend file.
(write-char #\X s))
- (with-test-file (s file :class 'file-simple-stream :direction :input
- :if-does-not-exist :error)
+ (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
- (let ((file (merge-pathnames #p"test-data.txt" *test-path*)))
- (with-test-file (s file :class 'file-simple-stream :direction :io
+ (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)
(write-char #\X s)
(file-position s :end) ; Extend file.
(write-char #\X s))
- (with-test-file (s file :class 'file-simple-stream :direction :input
- :if-does-not-exist :error)
+ (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)
+
+(defparameter *multi-line-string*
+ "This file was created by simple-stream-tests.lisp.
+Nothing to see here, move along.")
+
+(defmacro with-dc-test-stream ((s &key initial-content) &body body)
+ `(with-test-file
+ (.ansi-stream.
+ *test-file*
+ :direction :io
+ :if-exists :overwrite
+ :initial-content ,(or initial-content '*multi-line-string*))
+ (let ((,s (make-instance 'terminal-simple-stream
+ :input-handle (sb-kernel::fd-stream-fd .ansi-stream.)
+ :output-handle (sb-kernel::fd-stream-fd .ansi-stream.))))
+ ,@body)))
+
+(defmacro with-sc-test-stream ((s &key initial-content) &body body)
+ `(with-test-file
+ (,s
+ *test-file*
+ :class 'file-simple-stream
+ :direction :io
+ :if-exists :overwrite
+ :initial-content ,(or initial-content '*multi-line-string*))
+ ,@body))
+
+(deftest listen-dc-1
+ ;; LISTEN with filled buffer
+ (with-dc-test-stream (s) (read-char s) (listen s))
+ T)
+
+(deftest listen-dc-2
+ ;; LISTEN with empty buffer
+ (with-dc-test-stream (s) (listen s))
+ T)
+
+(deftest listen-dc-3
+ ;; LISTEN at EOF
+ (with-dc-test-stream (s)
+ (read-line s)
+ (read-line s)
+ (listen s))
+ NIL)
+
+;;; the following tests are for problems fixed in SBCL 0.8.6.2:
+
+(deftest charpos-1
+ ;; check for bug involving the -1 vs. 0 oddity in std-dc-newline-in-handler
+ ;;
+ ;; Note: It not not clear to me that input should affect the CHARPOS at
+ ;; all. (Except for a terminal stream perhaps, which our test stream
+ ;; happens to be. Hmm.)
+ ;;
+ ;; But CHARPOS must not be -1, so much is sure, hence this test is right
+ ;; in any case.
+ (with-dc-test-stream (s)
+ (read-line s)
+ (sb-simple-streams:charpos s))
+ 0)
+
+(deftest charpos-2
+ ;; FIXME: It not not clear to me that input should affect the CHARPOS at
+ ;; all, and indeed it does not. That is, except for newlines?! (see above)
+ ;;
+ ;; What this test does is (a) check that the CHARPOS works at all without
+ ;; erroring and (b) force anyone changing the CHARPOS behaviour to read
+ ;; this comment and start thinking things through better than I can.
+ (with-dc-test-stream (s)
+ (read-char s)
+ (and (eql (sb-kernel:charpos s) 0)
+ (eql (sb-simple-streams:charpos s) 0)))
+ T)
+
+(deftest reader-1
+ ;; does the reader support simple streams? Note that, say, "123" instead
+ ;; of "(1 2)" does not trigger the bugs present in SBCL 0.8.6.
+ (with-dc-test-stream (s :initial-content "(1 2)")
+ (equal (read s) '(1 2)))
+ T)
+
+(deftest line-length-dc-1
+ ;; does LINE-LENGTH support simple streams?
+ (with-dc-test-stream (s)
+ (eql (sb-simple-streams:line-length s)
+ (sb-kernel:line-length s)))
+ T)
+
+(defvar *synonym*)
+
+;; the biggest change in 0.8.6.2:
+;; support composite streams writing to simple streams
+
+;; first, SYNONYM-STREAM:
+
+(deftest synonym-stream-1
+ ;; READ-CHAR
+ (with-dc-test-stream (*synonym*)
+ (read-char (make-synonym-stream '*synonym*)))
+ #\T)
+
+(deftest synonym-stream-2
+ ;; UNREAD-CHAR (via STREAM-MISC-DISPATCH)
+ (with-dc-test-stream (*synonym*)
+ (let ((s (make-synonym-stream '*synonym*)))
+ (unread-char (read-char s) s)
+ (read-char s)))
+ #\T)
+
+(deftest synonym-stream-3
+ ;; READ-BYTE
+ (with-dc-test-stream (*synonym*)
+ (read-byte (make-synonym-stream '*synonym*)))
+ #.(char-code #\T))
+
+(deftest synonym-stream-4
+ ;; WRITE-CHAR
+ (with-sc-test-stream (*synonym*)
+ (let ((s (make-synonym-stream '*synonym*)))
+ (write-char #\A s)
+ (file-position s 0)
+ (read-char s)))
+ #\A)
+
+(deftest synonym-stream-5
+ ;; WRITE-BYTE
+ (with-sc-test-stream (*synonym*)
+ (let ((s (make-synonym-stream '*synonym*)))
+ (write-byte 65 s)
+ (file-position s 0)
+ (read-char s)))
+ #\A)
+
+(deftest synonym-stream-6
+ ;; WRITE-STRING
+ (with-sc-test-stream (*synonym*)
+ (let ((s (make-synonym-stream '*synonym*)))
+ (write-string "ab" s)
+ (file-position s 0)
+ (and (char= (read-char s) #\a)
+ (char= (read-char s) #\b))))
+ T)
+
+(deftest synonym-stream-7
+ ;; LISTEN (via STREAM-MISC-DISPATCH)
+ (with-sc-test-stream (*synonym*)
+ (let ((s (make-synonym-stream '*synonym*)))
+ (and (listen s) t)))
+ T)
+
+(deftest synonym-stream-8
+ ;; CLEAR-INPUT (via STREAM-MISC-DISPATCH)
+ (with-sc-test-stream (*synonym*)
+ (let ((s (make-synonym-stream '*synonym*)))
+ (clear-input s)))
+ NIL)
+
+(deftest synonym-stream-9
+ ;; FORCE-OUTPUT (via STREAM-MISC-DISPATCH)
+ (with-sc-test-stream (*synonym*)
+ ;; could test more here
+ (force-output (make-synonym-stream '*synonym*)))
+ NIL)
+
+(deftest synonym-stream-10
+ ;; FINISH-OUTPUT (via STREAM-MISC-DISPATCH)
+ (with-sc-test-stream (*synonym*)
+ ;; could test more here
+ (finish-output (make-synonym-stream '*synonym*)))
+ NIL)
+
+(deftest synonym-stream-11
+ ;; STREAM-ELEMENT-TYPE (via STREAM-MISC-DISPATCH)
+ (with-sc-test-stream (*synonym*)
+ (eql (stream-element-type (make-synonym-stream '*synonym*))
+ (stream-element-type *synonym*)))
+ T)
+
+(deftest synonym-stream-12
+ ;; INTERACTIVE-STREAM-P (via STREAM-MISC-DISPATCH)
+ (with-sc-test-stream (*synonym*)
+ (eql (interactive-stream-p (make-synonym-stream '*synonym*))
+ (interactive-stream-p *synonym*)))
+ T)
+
+(deftest synonym-stream-13
+ ;; LINE-LENGTH (via STREAM-MISC-DISPATCH)
+ (with-sc-test-stream (*synonym*)
+ (eql (sb-kernel:line-length (make-synonym-stream '*synonym*))
+ (sb-kernel:line-length *synonym*)))
+ T)
+
+(deftest synonym-stream-14
+ ;; CHARPOS (via STREAM-MISC-DISPATCH)
+ (with-sc-test-stream (*synonym*)
+ (eql (sb-kernel:charpos (make-synonym-stream '*synonym*))
+ (sb-kernel:charpos *synonym*)))
+ T)
+
+(deftest synonym-stream-15
+ ;; FILE-LENGTH (via STREAM-MISC-DISPATCH)
+ (with-sc-test-stream (*synonym*)
+ (eql (file-length (make-synonym-stream '*synonym*))
+ (file-length *synonym*)))
+ T)
+
+(deftest synonym-stream-16
+ ;; FILE-POSITION (via STREAM-MISC-DISPATCH)
+ (with-sc-test-stream (*synonym*)
+ (eql (file-position (make-synonym-stream '*synonym*))
+ (file-position *synonym*)))
+ T)
+
+;; SYNONYM-STREAM tests repeated for BROADCAST-STREAM, where applicable
+
+(deftest broadcast-stream-4
+ ;; WRITE-CHAR
+ (with-sc-test-stream (synonym)
+ (let ((s (make-broadcast-stream synonym)))
+ (write-char #\A s)
+ (force-output s))
+ (file-position synonym 0)
+ (read-char synonym))
+ #\A)
+
+(deftest broadcast-stream-5
+ ;; WRITE-BYTE
+ (with-sc-test-stream (synonym)
+ (let ((s (make-broadcast-stream synonym)))
+ (write-byte 65 s)
+ (force-output s))
+ (file-position synonym 0)
+ (read-char synonym))
+ #\A)
+
+(deftest broadcast-stream-6
+ ;; WRITE-STRING
+ (with-sc-test-stream (synonym)
+ (let ((s (make-broadcast-stream synonym)))
+ (write-string "ab" s)
+ (force-output s))
+ (file-position synonym 0)
+ (and (char= (read-char synonym) #\a)
+ (char= (read-char synonym) #\b)))
+ T)
+
+(deftest broadcast-stream-9
+ ;; FORCE-OUTPUT (via STREAM-MISC-DISPATCH)
+ (with-sc-test-stream (synonym)
+ ;; could test more here
+ (force-output (make-broadcast-stream synonym)))
+ NIL)
+
+(deftest broadcast-stream-10
+ ;; FINISH-OUTPUT (via STREAM-MISC-DISPATCH)
+ (with-sc-test-stream (synonym)
+ ;; could test more here
+ (finish-output (make-broadcast-stream synonym)))
+ NIL)
+
+(deftest broadcast-stream-11
+ ;; STREAM-ELEMENT-TYPE (via STREAM-MISC-DISPATCH)
+ (with-sc-test-stream (synonym)
+ (eql (stream-element-type (make-broadcast-stream synonym))
+ (stream-element-type synonym)))
+ T)
+
+(deftest broadcast-stream-12
+ ;; INTERACTIVE-STREAM-P (via STREAM-MISC-DISPATCH)
+ (with-sc-test-stream (synonym)
+ (eql (interactive-stream-p (make-broadcast-stream synonym))
+ (interactive-stream-p synonym)))
+ T)
+
+(deftest broadcast-stream-13
+ ;; LINE-LENGTH (via STREAM-MISC-DISPATCH)
+ (with-sc-test-stream (synonym)
+ (eql (sb-kernel:line-length (make-broadcast-stream synonym))
+ (sb-kernel:line-length synonym)))
+ T)
+
+(deftest broadcast-stream-14
+ ;; CHARPOS (via STREAM-MISC-DISPATCH)
+ (with-sc-test-stream (synonym)
+ (eql (sb-kernel:charpos (make-broadcast-stream synonym))
+ (sb-kernel:charpos synonym)))
+ T)
+
+(deftest broadcast-stream-16
+ ;; FILE-POSITION (via STREAM-MISC-DISPATCH)
+ (with-sc-test-stream (synonym)
+ (eql (file-position (make-broadcast-stream synonym))
+ (file-position synonym)))
+ T)
+
+;; SYNONYM-STREAM tests repeated for TWO-WAY-STREAM, where applicable
+
+(deftest two-way-stream-1
+ ;; READ-CHAR
+ (with-dc-test-stream (synonym)
+ (read-char (make-two-way-stream synonym synonym)))
+ #\T)
+
+(deftest two-way-stream-2
+ ;; UNREAD-CHAR (via STREAM-MISC-DISPATCH)
+ (with-dc-test-stream (synonym)
+ (let ((s (make-two-way-stream synonym synonym)))
+ (unread-char (read-char s) s)
+ (read-char s)))
+ #\T)
+
+(deftest two-way-stream-3
+ ;; READ-BYTE
+ (with-dc-test-stream (synonym)
+ (read-byte (make-two-way-stream synonym synonym)))
+ #.(char-code #\T))
+
+(deftest two-way-stream-4
+ ;; WRITE-CHAR
+ (with-sc-test-stream (synonym)
+ (let ((s (make-two-way-stream synonym synonym)))
+ (write-char #\A s)
+ (force-output s))
+ (file-position synonym 0)
+ (read-char synonym))
+ #\A)
+
+(deftest two-way-stream-5
+ ;; WRITE-BYTE
+ (with-sc-test-stream (synonym)
+ (let ((s (make-two-way-stream synonym synonym)))
+ (write-byte 65 s)
+ (force-output s))
+ (file-position synonym 0)
+ (read-char synonym))
+ #\A)
+
+(deftest two-way-stream-6
+ ;; WRITE-STRING
+ (with-sc-test-stream (synonym)
+ (let ((s (make-two-way-stream synonym synonym)))
+ (write-string "ab" s)
+ (force-output s))
+ (file-position synonym 0)
+ (and (char= (read-char synonym) #\a)
+ (char= (read-char synonym) #\b)))
+ T)
+
+(deftest two-way-stream-7
+ ;; LISTEN (via STREAM-MISC-DISPATCH)
+ (with-sc-test-stream (synonym)
+ (let ((s (make-two-way-stream synonym synonym)))
+ (and (listen s) t)))
+ T)
+
+(deftest two-way-stream-8
+ ;; CLEAR-INPUT (via STREAM-MISC-DISPATCH)
+ (with-sc-test-stream (synonym)
+ (let ((s (make-two-way-stream synonym synonym)))
+ (clear-input s)))
+ NIL)
+
+(deftest two-way-stream-9
+ ;; FORCE-OUTPUT (via STREAM-MISC-DISPATCH)
+ (with-sc-test-stream (synonym)
+ ;; could test more here
+ (force-output (make-two-way-stream synonym synonym)))
+ NIL)
+
+(deftest two-way-stream-10
+ ;; FINISH-OUTPUT (via STREAM-MISC-DISPATCH)
+ (with-sc-test-stream (synonym)
+ ;; could test more here
+ (finish-output (make-two-way-stream synonym synonym)))
+ NIL)
+
+(deftest two-way-stream-11
+ ;; STREAM-ELEMENT-TYPE (via STREAM-MISC-DISPATCH)
+ (with-sc-test-stream (synonym)
+ (eql (stream-element-type (make-two-way-stream synonym synonym))
+ (stream-element-type synonym)))
+ T)
+
+(deftest two-way-stream-12
+ ;; INTERACTIVE-STREAM-P (via STREAM-MISC-DISPATCH)
+ (with-sc-test-stream (synonym)
+ (eql (interactive-stream-p (make-two-way-stream synonym synonym))
+ (interactive-stream-p synonym)))
+ T)
+
+(deftest two-way-stream-13
+ ;; LINE-LENGTH (via STREAM-MISC-DISPATCH)
+ (with-sc-test-stream (synonym)
+ (eql (sb-kernel:line-length (make-two-way-stream synonym synonym))
+ (sb-kernel:line-length synonym)))
+ T)
+
+(deftest two-way-stream-14
+ ;; CHARPOS (via STREAM-MISC-DISPATCH)
+ (with-sc-test-stream (synonym)
+ (eql (sb-kernel:charpos (make-two-way-stream synonym synonym))
+ (sb-kernel:charpos synonym)))
+ T)
+
+(deftest two-way-stream-16
+ ;; FILE-POSITION (via STREAM-MISC-DISPATCH)
+ (with-sc-test-stream (synonym)
+ (eql (file-position (make-two-way-stream synonym synonym))
+ (file-position synonym)))
+ T)
+
+;; SYNONYM-STREAM tests repeated for ECHO-STREAM, where applicable
+
+(deftest echo-stream-1
+ ;; READ-CHAR
+ (with-dc-test-stream (*synonym*)
+ (read-char (make-echo-stream *synonym* *synonym*)))
+ #\T)
+
+(deftest echo-stream-2
+ ;; UNREAD-CHAR (via STREAM-MISC-DISPATCH)
+ (with-dc-test-stream (*synonym*)
+ (let ((s (make-echo-stream *synonym* *synonym*)))
+ (unread-char (read-char s) s)
+ (read-char s)))
+ #\T)
+
+(deftest echo-stream-3
+ ;; READ-BYTE
+ (with-dc-test-stream (*synonym*)
+ (read-byte (make-echo-stream *synonym* *synonym*)))
+ #.(char-code #\T))
+
+(deftest echo-stream-7
+ ;; LISTEN (via STREAM-MISC-DISPATCH)
+ (with-sc-test-stream (*synonym*)
+ (let ((s (make-echo-stream *synonym* *synonym*)))
+ (and (listen s) t)))
+ T)
+
+(deftest echo-stream-8
+ ;; CLEAR-INPUT (via STREAM-MISC-DISPATCH)
+ (with-sc-test-stream (*synonym*)
+ (let ((s (make-echo-stream *synonym* *synonym*)))
+ (clear-input s)))
+ NIL)
+
+(deftest echo-stream-11
+ ;; STREAM-ELEMENT-TYPE (via STREAM-MISC-DISPATCH)
+ (with-sc-test-stream (*synonym*)
+ (eql (stream-element-type (make-echo-stream *synonym* *synonym*))
+ (stream-element-type *synonym*)))
+ T)
+
+(deftest echo-stream-12
+ ;; INTERACTIVE-STREAM-P (via STREAM-MISC-DISPATCH)
+ (with-sc-test-stream (*synonym*)
+ (eql (interactive-stream-p (make-echo-stream *synonym* *synonym*))
+ (interactive-stream-p *synonym*)))
+ T)
+
+(deftest echo-stream-13
+ ;; LINE-LENGTH (via STREAM-MISC-DISPATCH)
+ (with-sc-test-stream (*synonym*)
+ (eql (sb-kernel:line-length (make-echo-stream *synonym* *synonym*))
+ (sb-kernel:line-length *synonym*)))
+ T)
+
+(deftest echo-stream-14
+ ;; CHARPOS (via STREAM-MISC-DISPATCH)
+ (with-sc-test-stream (*synonym*)
+ (eql (sb-kernel:charpos (make-echo-stream *synonym* *synonym*))
+ (sb-kernel:charpos *synonym*)))
+ T)
+
+(deftest echo-stream-16
+ ;; FILE-POSITION (via STREAM-MISC-DISPATCH)
+ (with-sc-test-stream (*synonym*)
+ (eql (file-position (make-echo-stream *synonym* *synonym*))
+ (file-position *synonym*)))
+ T)
+
+;; SYNONYM-STREAM tests repeated for CONCATENATED-STREAM, where applicable
+
+(deftest concatenated-stream-1
+ ;; READ-CHAR
+ (with-dc-test-stream (*synonym*)
+ (read-char (make-concatenated-stream *synonym*)))
+ #\T)
+
+(deftest concatenated-stream-2
+ ;; UNREAD-CHAR (via STREAM-MISC-DISPATCH)
+ (with-dc-test-stream (*synonym*)
+ (let ((s (make-concatenated-stream *synonym*)))
+ (unread-char (read-char s) s)
+ (read-char s)))
+ #\T)
+
+(deftest concatenated-stream-3
+ ;; READ-BYTE
+ (with-dc-test-stream (*synonym*)
+ (read-byte (make-concatenated-stream *synonym*)))
+ #.(char-code #\T))
+
+(deftest concatenated-stream-7
+ ;; LISTEN (via STREAM-MISC-DISPATCH)
+ (with-sc-test-stream (*synonym*)
+ (let ((s (make-concatenated-stream *synonym*)))
+ (and (listen s) t)))
+ T)
+
+(deftest concatenated-stream-8
+ ;; CLEAR-INPUT (via STREAM-MISC-DISPATCH)
+ (with-sc-test-stream (*synonym*)
+ (let ((s (make-concatenated-stream *synonym*)))
+ (clear-input s)))
+ NIL)
+
+(deftest concatenated-stream-11
+ ;; STREAM-ELEMENT-TYPE (via STREAM-MISC-DISPATCH)
+ (with-sc-test-stream (*synonym*)
+ (eql (stream-element-type (make-concatenated-stream *synonym*))
+ (stream-element-type *synonym*)))
+ T)
+
+(deftest concatenated-stream-12
+ ;; INTERACTIVE-STREAM-P (via STREAM-MISC-DISPATCH)
+ (with-sc-test-stream (*synonym*)
+ (eql (interactive-stream-p (make-concatenated-stream *synonym*))
+ (interactive-stream-p *synonym*)))
+ T)
+
+(deftest concatenated-stream-13
+ ;; LINE-LENGTH (via STREAM-MISC-DISPATCH)
+ (with-sc-test-stream (*synonym*)
+ (eql (sb-kernel:line-length (make-concatenated-stream *synonym*))
+ (sb-kernel:line-length *synonym*)))
+ T)
+
+(deftest concatenated-stream-14
+ ;; CHARPOS (via STREAM-MISC-DISPATCH)
+ (with-sc-test-stream (*synonym*)
+ (eql (sb-kernel:charpos (make-concatenated-stream *synonym*))
+ (sb-kernel:charpos *synonym*)))
+ T)
+
+(deftest concatenated-stream-16
+ ;; FILE-POSITION (via STREAM-MISC-DISPATCH)
+ (with-sc-test-stream (*synonym*)
+ (eql (file-position (make-concatenated-stream *synonym*))
+ (file-position *synonym*)))
+ T)
+
+;; uncovered by synonym-stream-15
+
+(deftest file-simple-stream-1
+ (values (subtypep 'file-simple-stream 'file-stream))
+ T)
+
+(deftest string-simple-stream-1
+ (values (subtypep 'string-simple-stream 'string-stream))
+ T)
+
+;; don't break fd-stream external-format support:
+
+(deftest external-format-1
+ (progn
+ (with-open-file (s *test-file*
+ :direction :output
+ :if-exists :supersede
+ :element-type '(unsigned-byte 8))
+ (write-byte 195 s)
+ (write-byte 132 s))
+ (with-open-file (s *test-file*
+ :direction :input
+ :external-format :utf-8)
+ (char-code (read-char s))))
+ 196)
+
+;; launchpad bug #491087
+
+(deftest lp491087
+ (labels ((read-big-int (stream)
+ (let ((b (make-array 1 :element-type '(signed-byte 32)
+ :initial-element 0)))
+ (declare (dynamic-extent b))
+ (sb-simple-streams::read-vector b stream
+ :endian-swap :network-order)
+ (aref b 0))))
+ (with-open-file (stream
+ (merge-pathnames #P"lp491087.txt" *test-path*)
+ :class 'file-simple-stream)
+ (let* ((start (file-position stream))
+ (integer (read-big-int stream))
+ (end (file-position stream)))
+ (and (= start 0)
+ (= integer #x30313233)
+ (= end 4)))))
+ T)
projects / sbcl.git / blobdiff