;;; 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)
;;; 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? (eval '(formatter "~>")) sb-format:format-error))
+(assert (raises-error? (eval '(format t "~>")) sb-format:format-error))
+
+;;; readably printing hash-tables, check for circularity
+(let ((x (cons 1 2))
+ (h (make-hash-table))
+ (*print-readably* t)
+ (*print-circle* t)
+ (*read-eval* t))
+ (setf (gethash x h) h)
+ (destructuring-bind (x2 . h2) (read-from-string (write-to-string (cons x h)))
+ (assert (equal x x2))
+ (assert (eq h2 (gethash x2 h2)))))
+
+;;; an off-by-one error in the ~R format directive until 1.0.15.20
+;;; prevented printing cardinals and ordinals between (expt 10 63) and
+;;; (1- (expt 10 66))
+(assert (string= (format nil "~R" (expt 10 63)) "one vigintillion"))
+(assert (string= (format nil "~:R" (expt 10 63)) "one vigintillionth"))
+
+;;; too-clever cacheing for PRINT-OBJECT resulted in a bogus method
+;;; for printing RESTART objects. Check also CONTROL-STACK-EXHAUSTED
+;;; and HEAP-EXHAUSTED-ERROR.
+(let ((result (with-output-to-string (*standard-output*)
+ (princ (find-restart 'abort)))))
+ (assert (string/= result "#<" :end1 2)))
+(let ((result (with-output-to-string (*standard-output*)
+ (princ (make-condition 'sb-kernel::control-stack-exhausted)))))
+ (assert (string/= result "#<" :end1 2)))
+(let ((result (with-output-to-string (*standard-output*)
+ (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)))))))
+
;;; success
projects / sbcl.git / blobdiff