0.7.12.9:

[sbcl.git] / tests / gray-streams.impure.lisp

diff --git a/tests/gray-streams.impure.lisp b/tests/gray-streams.impure.lisp
index 5f96206..2fb58c9 100644 (file)
--- 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.
@@ -73,7 +69,6 @@
 ;;;; 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))
@@ -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)))
 \f
@@ -183,6 +169,52 @@
        (assert (null (fresh-line our-char-output)))
        (write-char #\c our-char-output)))
    (format nil "a ~%b~%c")))
+
+;;; Patches introduced in sbcl-0.6.11.5 made the pretty-print logic
+;;; test not only *PRINT-PRETTY* but also PRETTY-STREAM-P in some
+;;; cases. Try to verify that we don't end up doing tests like that on
+;;; 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
+                    "~@<testing: ~@:_pretty Gray line breaks~:>~%")))))
+  (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)))))
 \f
 ;;;; example classes for binary output
 
@@ -200,12 +232,10 @@
   '(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))
 
 (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))
   
@@ -225,7 +255,7 @@
 
 (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)