X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;ds=sidebyside;f=tests%2Fprint.impure.lisp;h=6d8072f0d91539a34a5f4fd89bdb11c36e4e974a;hb=35f870eecfcaaba496d54e0f290b09e63884f74c;hp=8d22b9d8149991bbb86b8f927c43381df5054fbe;hpb=175c318c892b0627b36fa3c4db66f59680242204;p=sbcl.git

diff --git a/tests/print.impure.lisp b/tests/print.impure.lisp
index 8d22b9d..6d8072f 100644
--- a/tests/print.impure.lisp
+++ b/tests/print.impure.lisp
@@ -322,7 +322,7 @@
 
 ;;; CSR inserted a bug into Burger & Dybvig's float printer.  Caught
 ;;; by Raymond Toy
-(assert (string= (format nil "~E" 1d23) "1.0d+23"))
+(assert (string= (format nil "~E" 1d23) "1.d+23"))
 
 ;;; Fixed-format bugs from CLISP's test suite (reported by Bruno
 ;;; Haible, bug 317)
@@ -337,4 +337,83 @@
 ;;; Adam Warner's test case
 (assert (string= (format nil "~@F" 1.23) "+1.23"))
 
+
+;;; New (2005-11-08, also known as CSR House day) float format test
+;;; cases.  Simon Alexander, Raymond Toy, and others
+(assert (string= (format nil "~9,4,,-7E" pi) ".00000003d+8"))
+(assert (string= (format nil "~9,4,,-5E" pi) ".000003d+6"))
+(assert (string= (format nil "~5,4,,7E" pi) "3141600.d-6"))
+(assert (string= (format nil "~11,4,,3E" pi) "  314.16d-2"))
+(assert (string= (format nil "~11,4,,5E" pi) "  31416.d-4"))
+(assert (string= (format nil "~11,4,,0E" pi) "  0.3142d+1"))
+(assert (string= (format nil "~9,,,-1E" pi) ".03142d+2"))
+(assert (string= (format nil "~,,,-2E" pi) "0.003141592653589793d+3"))
+(assert (string= (format nil "~,,,2E" pi) "31.41592653589793d-1"))
+(assert (string= (format nil "~E" pi) "3.141592653589793d+0"))
+(assert (string= (format nil "~9,5,,-1E" pi) ".03142d+2"))
+(assert (string= (format nil "~11,5,,-1E" pi) " 0.03142d+2"))
+(assert (string= (format nil "~G" pi) "3.141592653589793    "))
+(assert (string= (format nil "~9,5G" pi) "3.1416    "))
+(assert (string= (format nil "|~13,6,2,7E|" pi) "| 3141593.d-06|"))
+(assert (string= (format nil "~9,3,2,0,'%E" pi) "0.314d+01"))
+(assert (string= (format nil "~9,0,6f" pi) " 3141593."))
+(assert (string= (format nil "~6,2,1,'*F" pi) " 31.42"))
+(assert (string= (format nil "~6,2,1,'*F" (* 100 pi)) "******"))
+(assert (string= (format nil "~9,3,2,-2,'%@E" pi) "+.003d+03"))
+(assert (string= (format nil "~10,3,2,-2,'%@E" pi) "+0.003d+03"))
+(assert (string= (format nil "~15,3,2,-2,'%,'=@E" pi) "=====+0.003d+03"))
+(assert (string= (format nil "~9,3,2,-2,'%E" pi) "0.003d+03"))
+(assert (string= (format nil "~8,3,2,-2,'%@E" pi) "%%%%%%%%"))
+
+(assert (string= (format nil "~g" 1e0) "1.    "))
+(assert (string= (format nil "~g" 1.2d40) "12000000000000000000000000000000000000000.    "))
+
+(assert (string= (format nil "~e" 0) "0.0e+0"))
+(assert (string= (format nil "~e" 0d0) "0.0d+0"))
+(assert (string= (format nil "~9,,4e" 0d0) "0.0d+0000"))
+
+(let ((table (make-hash-table)))
+  (setf (gethash 1 table) t)
+  (assert
+   (raises-error? (with-standard-io-syntax
+                    (let ((*read-eval* nil)
+                          (*print-readably* t))
+                      (with-output-to-string (*standard-output*)
+                        (prin1 table))))
+                  print-not-readable)))
+
+;; Test that we can print characters readably regardless of the external format
+;; of the stream.
+
+(defun test-readable-character (character external-format)
+  (let ((file "print.impure.tmp"))
+    (unwind-protect
+         (progn
+           (with-open-file (stream file
+                                   :direction :output
+                                   :external-format external-format
+                                   :if-exists :supersede)
+             (write character :stream stream :readably t))
+           (with-open-file (stream file
+                                   :direction :input
+                                   :external-format external-format
+                                   :if-does-not-exist :error)
+             (assert (char= (read stream) character))))
+      (ignore-errors
+        (delete-file file)))))
+
+#+sb-unicode
+(with-test (:name (:print-readable :character :utf-8))
+  (test-readable-character (code-char #xfffe) :utf-8))
+
+#+sb-unicode
+(with-test (:name (:print-readable :character :iso-8859-1))
+  (test-readable-character (code-char #xfffe) :iso-8859-1))
+
+(assert (string= (eval '(format nil "~:C" #\a)) "a"))
+(assert (string= (format nil (formatter "~:C") #\a) "a"))
+
+;;; This used to trigger an AVER instead.
+(assert (raises-error? (format t "~>") sb-format:format-error))
+
 ;;; success