0.6.11.30:

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

diff --git a/tests/gray-streams.impure.lisp b/tests/gray-streams.impure.lisp
index 61edffe..585aa0a 100644 (file)
--- a/tests/gray-streams.impure.lisp
+++ b/tests/gray-streams.impure.lisp
@@ -167,6 +167,35 @@
                    (format our-char-output "~A~%" line))
                  (assert (null (peek-char nil our-char-input nil nil nil)))))
              test-string))))
+
+(assert
+  (equal
+   (with-output-to-string (foo)
+     (let ((our-char-output (make-character-output-stream foo)))
+       (write-char #\a our-char-output)
+       (finish-output our-char-output)
+       (write-char #\  our-char-output)
+       (force-output our-char-output)
+       (fresh-line our-char-output)
+       (write-char #\b our-char-output)
+       (clear-output our-char-output)
+       (terpri our-char-output)
+       (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))))))
 \f
 ;;;; example classes for binary output