X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=tests%2Fgray-streams.impure.lisp;h=f20c68b5fe674ad382ceaaa68da8fd8b363fe902;hb=13deb21bc0d8e9d68b3f449ca971c3c7fd332f4b;hp=585aa0ab01290d14f6f851e9b5b6de4f488d6fa6;hpb=4a4f1e5ca70363d64d7cbb141863a387334e6760;p=sbcl.git diff --git a/tests/gray-streams.impure.lisp b/tests/gray-streams.impure.lisp index 585aa0a..f20c68b 100644 --- a/tests/gray-streams.impure.lisp +++ b/tests/gray-streams.impure.lisp @@ -1,8 +1,4 @@ -;;;; This file is for compiler tests which have side effects (e.g. -;;;; executing DEFUN) but which don't need any special side-effecting -;;;; environmental stuff (e.g. DECLAIM of particular optimization -;;;; settings). Similar tests which *do* expect special settings may -;;;; be in files compiler-1.impure.lisp, compiler-2.impure.lisp, etc. +;;;; tests related to Gray streams ;;;; This software is part of the SBCL system. See the README file for ;;;; more information. @@ -10,7 +6,7 @@ ;;;; While most of SBCL is derived from the CMU CL system, the test ;;;; files (like this one) were written from scratch after the fork ;;;; from CMU CL. -;;;; +;;;; ;;;; This software is in the public domain and is provided with ;;;; absolutely no warranty. See the COPYING and CREDITS files for ;;;; more information. @@ -64,24 +60,23 @@ (defclass character-output-stream (fundamental-character-output-stream) ((lisp-stream :initarg :lisp-stream - :accessor character-output-stream-lisp-stream))) - + :accessor character-output-stream-lisp-stream))) + (defclass character-input-stream (fundamental-character-input-stream) ((lisp-stream :initarg :lisp-stream - :accessor character-input-stream-lisp-stream))) - + :accessor character-input-stream-lisp-stream))) + ;;;; example character output stream encapsulating a lisp-stream (defun make-character-output-stream (lisp-stream) - (declare (type sb-kernel:lisp-stream lisp-stream)) (make-instance 'character-output-stream :lisp-stream lisp-stream)) - + (defmethod open-stream-p ((stream character-output-stream)) (open-stream-p (character-output-stream-lisp-stream stream))) - + (defmethod close ((stream character-output-stream) &key abort) (close (character-output-stream-lisp-stream stream) :abort abort)) - + (defmethod input-stream-p ((stream character-output-stream)) (input-stream-p (character-output-stream-lisp-stream stream))) @@ -109,7 +104,6 @@ ;;;; example character input stream encapsulating a lisp-stream (defun make-character-input-stream (lisp-stream) - (declare (type sb-kernel:lisp-stream lisp-stream)) (make-instance 'character-input-stream :lisp-stream lisp-stream)) (defmethod open-stream-p ((stream character-input-stream)) @@ -133,14 +127,6 @@ (defmethod stream-read-char-no-hang ((stream character-input-stream)) (read-char-no-hang (character-input-stream-lisp-stream stream) nil :eof)) -#+nil -(defmethod stream-peek-char ((stream character-input-stream)) - (peek-char nil (character-input-stream-lisp-stream stream) nil :eof)) - -#+nil -(defmethod stream-listen ((stream character-input-stream)) - (listen (character-input-stream-lisp-stream stream))) - (defmethod stream-clear-input ((stream character-input-stream)) (clear-input (character-input-stream-lisp-stream stream))) @@ -190,22 +176,55 @@ ;;; bare Gray streams and thus bogusly omitting pretty-printing ;;; operations. (flet ((frob () - (with-output-to-string (string) - (let ((gray-output-stream (make-character-output-stream string))) - (format gray-output-stream - "~@~%"))))) + (with-output-to-string (string) + (let ((gray-output-stream (make-character-output-stream string))) + (format gray-output-stream + "~@~%"))))) (assert (= 1 (count #\newline (let ((*print-pretty* nil)) (frob))))) (assert (= 2 (count #\newline (let ((*print-pretty* t)) (frob)))))) + +;;; tests for STREAM-READ-SEQUENCE/STREAM-WRITE-SEQUENCE for +;;; subclasses of FUNDAMENTAL-CHARACTER-INPUT-/OUTPUT-STREAM (i.e., +;;; where the default methods are available) +(let* ((test-string (format nil + "~% Testing for STREAM-*-SEQUENCE.~ + ~& This is the second line.~ + ~% This should be the third and last line.~%")) + (test-string-len (length test-string)) + (output-test-string (make-string test-string-len))) + ;; test for READ-/WRITE-SEQUENCE on strings/vectors + (with-input-from-string (foo test-string) + (assert (equal + (with-output-to-string (bar) + (let ((our-char-input (make-character-input-stream foo)) + (our-char-output (make-character-output-stream bar))) + (read-sequence output-test-string our-char-input) + (assert (typep output-test-string 'string)) + (write-sequence output-test-string our-char-output) + (assert (null (peek-char nil our-char-input nil nil nil))))) + test-string))) + ;; test for READ-/WRITE-SEQUENCE on lists + (let ((output-test-list (make-list test-string-len))) + (with-input-from-string (foo test-string) + (assert (equal + (with-output-to-string (bar) + (let ((our-char-input (make-character-input-stream foo)) + (our-char-output (make-character-output-stream bar))) + (read-sequence output-test-list our-char-input) + (assert (typep output-test-list 'list)) + (write-sequence output-test-list our-char-output) + (assert (null (peek-char nil our-char-input nil nil nil))))) + test-string))))) ;;;; example classes for binary output (defclass binary-to-char-output-stream (fundamental-binary-output-stream) ((lisp-stream :initarg :lisp-stream - :accessor binary-to-char-output-stream-lisp-stream))) - + :accessor binary-to-char-output-stream-lisp-stream))) + (defclass binary-to-char-input-stream (fundamental-binary-input-stream) ((lisp-stream :initarg :lisp-stream - :accessor binary-to-char-input-stream-lisp-stream))) + :accessor binary-to-char-input-stream-lisp-stream))) (defmethod stream-element-type ((stream binary-to-char-output-stream)) '(unsigned-byte 8)) @@ -213,39 +232,37 @@ '(unsigned-byte 8)) (defun make-binary-to-char-input-stream (lisp-stream) - (declare (type sb-kernel:lisp-stream lisp-stream)) (make-instance 'binary-to-char-input-stream - :lisp-stream lisp-stream)) + :lisp-stream lisp-stream)) (defun make-binary-to-char-output-stream (lisp-stream) - (declare (type sb-kernel:lisp-stream lisp-stream)) (make-instance 'binary-to-char-output-stream - :lisp-stream lisp-stream)) - + :lisp-stream lisp-stream)) + (defmethod stream-read-byte ((stream binary-to-char-input-stream)) (let ((char (read-char - (binary-to-char-input-stream-lisp-stream stream) nil :eof))) + (binary-to-char-input-stream-lisp-stream stream) nil :eof))) (if (eq char :eof) - char - (char-code char)))) + char + (char-code char)))) (defmethod stream-write-byte ((stream binary-to-char-output-stream) integer) (let ((char (code-char integer))) (write-char char - (binary-to-char-output-stream-lisp-stream stream)))) - + (binary-to-char-output-stream-lisp-stream stream)))) + ;;;; tests using binary i/o, using the above (let ((test-string (format nil "~% This is a test.~& This is the second line.~ - ~% This should be the third and last line.~%"))) + ~% This should be the third and last line.~%"))) (with-input-from-string (foo test-string) (assert (equal (with-output-to-string (bar) (let ((our-bin-to-char-input (make-binary-to-char-input-stream - foo)) + foo)) (our-bin-to-char-output (make-binary-to-char-output-stream - bar))) + bar))) (assert (open-stream-p our-bin-to-char-input)) (assert (open-stream-p our-bin-to-char-output)) (assert (input-stream-p our-bin-to-char-input)) @@ -254,7 +271,3 @@ ((eq byte :eof)) (write-byte byte our-bin-to-char-output)))) test-string)))) - -;;;; Voila! - -(quit :unix-status 104) ; success