X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=tests%2Fprint.impure.lisp;h=9b4f13d3d94aded4112140ad40b18f3bbb911d28;hb=82f9c527cb607ccd19e5b24261dfe9af7b1ba72e;hp=81cb0f33cd72fcd7b94b1c01edd4dfd4e5d0295d;hpb=d7eeed8e500932c38cd2c7d22ea1ff9630d2f7c8;p=sbcl.git

diff --git a/tests/print.impure.lisp b/tests/print.impure.lisp
index 81cb0f3..9b4f13d 100644
--- a/tests/print.impure.lisp
+++ b/tests/print.impure.lisp
@@ -447,4 +447,66 @@
                 (princ (make-condition 'sb-kernel::heap-exhausted-error)))))
   (assert (string/= result "#<" :end1 2)))
 
+(with-test (:name (:with-standard-io-syntax :bind-print-pprint-dispatch))
+  (let ((*print-pprint-dispatch* (copy-pprint-dispatch nil)))
+    (set-pprint-dispatch 'symbol #'(lambda (stream obj)
+                                     (declare (ignore obj))
+                                     (write-string "FOO" stream)))
+    (with-standard-io-syntax
+      (let ((*print-pretty* t))
+        (assert (string= (princ-to-string 'bar) "BAR"))))))
+
+;;; bug-lp#488979
+
+(defclass a-class-name () ())
+
+(assert (find #\Newline
+              (let ((*print-pretty* t)
+                    (*print-right-margin* 10))
+                (format nil "~A" (make-instance 'a-class-name)))
+              :test #'char=))
+
+(assert (not (find #\Newline
+                   (let ((*print-pretty* nil)
+                         (*print-right-margin* 10))
+                     (format nil "~A" (make-instance 'a-class-name)))
+                   :test #'char=)))
+
+;;; The PRINT-OBJECT method for RANDOM-STATE used to have a bogus
+;;; dimension argument for MAKE-ARRAY.
+(with-test (:name :print-random-state)
+  (assert (equalp *random-state*
+                  (read-from-string
+                   (write-to-string *random-state*)))))
+
+(with-test (:name :write-return-value)
+  (assert (= 123 (funcall (compile nil (lambda ()
+                                         (write 123)))))))
+
+(with-test (:name :write/write-to-string-compiler-macro-lp/598374+581564)
+  (let ((test (compile nil
+                       `(lambda (object &optional output-stream)
+                          (write object
+                                 :stream output-stream)))))
+    (assert (equal "(HELLO WORLD)"
+                   (with-output-to-string (*standard-output*)
+                     (let ((list '(hello world)))
+                       (assert (eq list (funcall test list)))))))
+    (assert (equal "12"
+                   (with-output-to-string (*standard-output*)
+                     (assert (eql 12 (funcall test 12)))))))
+  (let ((test (compile nil
+                       `(lambda ()
+                          (let ((*print-length* 42))
+                            (write-to-string *print-length* :length nil))))))
+    (assert (equal "42" (funcall test)))))
+
+(with-test (:name (:format :compile-literal-dest-string))
+  (assert (eq :warned
+              (handler-case
+                  (compile nil
+                           `(lambda (x) (format "~A" x)))
+                ((and warning (not style-warning)) ()
+                  :warned)))))
+
 ;;; success