X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=contrib%2Fsb-simple-streams%2Fsimple-stream-tests.lisp;h=20c5a8efc9214893a1a2892021385d13c018396d;hb=f057566fe993f008a9b34dc87b026e7c8ef2611d;hp=0373f75193515ef88f13ab8d2afe3a5bbed97c67;hpb=b42068e9080417a073dcb709cdd2e0315599b3df;p=sbcl.git diff --git a/contrib/sb-simple-streams/simple-stream-tests.lisp b/contrib/sb-simple-streams/simple-stream-tests.lisp index 0373f75..20c5a8e 100644 --- a/contrib/sb-simple-streams/simple-stream-tests.lisp +++ b/contrib/sb-simple-streams/simple-stream-tests.lisp @@ -10,11 +10,15 @@ "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.") -(eval-when (:load-toplevel) (ensure-directories-exist *test-path*)) +(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 (defun remove-key (key list) @@ -24,6 +28,15 @@ 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 @@ -47,40 +60,53 @@ (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) @@ -97,9 +123,8 @@ (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*)))) @@ -109,34 +134,37 @@ (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)))) @@ -145,7 +173,7 @@ (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) @@ -155,9 +183,8 @@ 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)))) @@ -166,7 +193,7 @@ (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) @@ -181,86 +208,95 @@ (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) @@ -271,8 +307,8 @@ (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) @@ -281,16 +317,16 @@ (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) @@ -298,8 +334,636 @@ (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)