X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=tests%2Fprint.impure.lisp;h=33f12aa488fe9852e5fd0a8414376fbb26592fa4;hb=171fde84561e232b8af8c05b82dfe8a8f9e08340;hp=382483a2cbc2af3242d9d72e1fcf7646a37721d6;hpb=8ac4167586be6db0ab26afa7ab6f326bb07c1a55;p=sbcl.git

diff --git a/tests/print.impure.lisp b/tests/print.impure.lisp
index 382483a..33f12aa 100644
--- a/tests/print.impure.lisp
+++ b/tests/print.impure.lisp
@@ -402,12 +402,10 @@
       (ignore-errors
         (delete-file file)))))
 
-#+sb-unicode
-(with-test (:name (:print-readable :character :utf-8))
+(with-test (:name (:print-readable :character :utf-8) :skipped-on '(not :sb-unicode))
   (test-readable-character (code-char #xfffe) :utf-8))
 
-#+sb-unicode
-(with-test (:name (:print-readable :character :iso-8859-1))
+(with-test (:name (:print-readable :character :iso-8859-1) :skipped-on '(not :sb-unicode))
   (test-readable-character (code-char #xfffe) :iso-8859-1))
 
 (assert (string= (eval '(format nil "~:C" #\a)) "a"))
@@ -472,4 +470,113 @@
                      (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)))))
+
+(with-test (:name :bug-308961)
+  (assert (string= (format nil "~4,1F" 0.001) " 0.0"))
+  (assert (string= (format nil "~4,1@F" 0.001) "+0.0"))
+  (assert (string= (format nil "~E" 0.01) "1.e-2"))
+  (assert (string= (format nil "~G" 0.01) "1.00e-2")))
+
+(with-test (:name (:fp-read/print-consistency single-float))
+  (let ((*random-state* (make-random-state t))
+        (oops))
+    (loop for f = most-positive-single-float then (/ f 2.0)
+          while (> f 0.0)
+          do (loop repeat 10
+                   for fr = (random f)
+                   do (unless (eql fr (read-from-string (prin1-to-string fr)))
+                        (push fr oops)
+                        (return))))
+    (loop for f = most-negative-single-float then (/ f 2.0)
+          while (< f -0.0)
+          do (loop repeat 10
+                   for fr = (- (random (- f)))
+                   do (unless (eql fr (read-from-string (prin1-to-string fr)))
+                        (push fr oops)
+                        (return))))
+    (when oops
+      (error "FP read/print inconsistencies:~%~:{  ~S => ~S~%~}"
+             (mapcar (lambda (f)
+                       (list f (read-from-string (prin1-to-string f))))
+                     oops)))))
+
+(with-test (:name (:fp-read/print-consistency double-float))
+  (let ((*random-state* (make-random-state t))
+        (oops))
+    ;; FIXME skipping denormalized floats due to bug 793774.
+    (loop for f = most-positive-double-float then (/ f 2d0)
+          while (> f 0d0)
+          do (loop repeat 10
+                   for fr = (random f)
+                   do (unless (float-denormalized-p fr)
+                        (unless (eql fr (read-from-string (prin1-to-string fr)))
+                          (push fr oops)
+                          (return)))))
+    (loop for f = most-negative-double-float then (/ f 2d0)
+          while (< f -0d0)
+          do (loop repeat 10
+                   for fr = (- (random (- f)))
+                   do (unless (float-denormalized-p fr)
+                        (unless (eql fr (read-from-string (prin1-to-string fr)))
+                          (push fr oops)
+                          (return)))))
+    (when oops
+      (error "FP read/print inconsistencies:~%~:{  ~S => ~S~%~}"
+             (mapcar (lambda (f)
+                       (list f (read-from-string (prin1-to-string f))))
+                     oops)))))
+
+(with-test (:name :bug-811386)
+  (assert (equal "   0.00" (format nil "~7,2,-2f" 0)))
+  (assert (equal "   0.00" (format nil "~7,2,2f" 0)))
+  (assert (equal "   0.01" (format nil "~7,2,-2f" 1)))
+  (assert (equal " 100.00" (format nil "~7,2,2f" 1)))
+  (assert (equal "   0.00" (format nil "~7,2,-2f" 0.1)))
+  (assert (equal "  10.00" (format nil "~7,2,2f" 0.1)))
+  (assert (equal "   0.01" (format nil "~7,2,-2f" 0.5))))
+
+(with-test (:name :bug-867684)
+  (assert (equal "ab" (format nil "a~0&b"))))
+
+(with-test (:name :print-unreadably-function)
+  (assert (equal "\"foo\""
+                 (handler-bind ((print-not-readable #'sb-ext:print-unreadably))
+                   (write-to-string (coerce "foo" 'base-string) :readably t)))))
+
 ;;; success