(format-dollars stream (next-arg) d n w pad colonp atsignp)))
(defun format-dollars (stream number d n w pad colon atsign)
- (if (rationalp number) (setq number (coerce number 'single-float)))
+ (when (rationalp number)
+ ;; This coercion to SINGLE-FLOAT seems as though it gratuitously
+ ;; loses precision (why not LONG-FLOAT?) but it's the default
+ ;; behavior in the ANSI spec, so in some sense it's the right
+ ;; thing, and at least the user shouldn't be surprised.
+ (setq number (coerce number 'single-float)))
(if (floatp number)
(let* ((signstr (if (minusp number) "-" (if atsign "+" "")))
(signlen (length signstr)))
(multiple-value-bind (str strlen ig2 ig3 pointplace)
- (sb!impl::flonum-to-string number nil d nil)
- (declare (ignore ig2 ig3))
- (when colon (write-string signstr stream))
- (dotimes (i (- w signlen (- n pointplace) strlen))
+ (sb!impl::flonum-to-string number nil d nil)
+ (declare (ignore ig2 ig3 strlen))
+ (when colon
+ (write-string signstr stream))
+ (dotimes (i (- w signlen (max n pointplace) 1 d))
(write-char pad stream))
- (unless colon (write-string signstr stream))
- (dotimes (i (- n pointplace)) (write-char #\0 stream))
+ (unless colon
+ (write-string signstr stream))
+ (dotimes (i (- n pointplace))
+ (write-char #\0 stream))
(write-string str stream)))
(format-write-field stream
(decimal-string number)
w 1 0 #\space t)))
\f
-;;;; format interpreters and support functions for line/page breaks etc.
+;;;; FORMAT interpreters and support functions for line/page breaks etc.
(def-format-interpreter #\% (colonp atsignp params)
(when (or colonp atsignp)
-;;;; This file is not used cold load time. Instead, it can be loaded
-;;;; into an initialized SBCL to get it into a nostalgic frame of
-;;;; mind, remembering the way things were in cold init, so that it
+;;;; This file is not used at cold load time. Instead, it can be
+;;;; loaded into an initialized SBCL to get it into a nostalgic frame
+;;;; of mind, remembering the way things were in cold init, so that it
;;;; can READ code which is ordinarily read only when bootstrapping.
;;;; (This can be useful when debugging the system, since the debugger
;;;; likes to be able to read the source for the code. It can also be
\f
;;;; package hacking
-;;; Our cross-compilation host is out of the picture now, so we no longer need
-;;; to worry about collisions between our package names and cross-compilation
-;;; host package names, so now is a good time to rename any package with a
-;;; bootstrap-only name SB!FOO to its permanent name SB-FOO.
+;;; Our cross-compilation host is out of the picture now, so we no
+;;; longer need to worry about collisions between our package names
+;;; and cross-compilation host package names, so now is a good time to
+;;; rename any package with a bootstrap-only name SB!FOO to its
+;;; permanent name SB-FOO.
;;;
-;;; (In principle it might be tidier to do this when dumping the cold image in
-;;; genesis, but in practice the logic might be a little messier because
-;;; genesis dumps both symbols and packages, and we'd need to make that dumped
-;;; symbols were renamed in the same way as dumped packages. Or we could do it
-;;; in cold init, but it's easier to experiment with and debug things here in
-;;; warm init than in cold init, so we do it here instead.)
+;;; (In principle it might be tidier to do this when dumping the cold
+;;; image in genesis, but in practice the logic might be a little
+;;; messier because genesis dumps both symbols and packages, and we'd
+;;; need to make sure that dumped symbols were renamed in the same way
+;;; as dumped packages. Or we could do it in cold init, but it's
+;;; easier to experiment with and debug things here in warm init than
+;;; in cold init, so we do it here instead.)
(let ((boot-prefix "SB!")
(perm-prefix "SB-"))
(dolist (package (list-all-packages))
(dolist (stem '(;; CLOS, derived from the PCL reference implementation
;;
;; This PCL build order is based on a particular
- ;; linearization of the declared build order
- ;; dependencies from the old PCL defsys.lisp
+ ;; (arbitrary) linearization of the declared build
+ ;; order dependencies from the old PCL defsys.lisp
;; dependency database.
"src/pcl/walk"
- ;; "src/pcl/iterate" removed 2001-12-20 njf
"src/pcl/early-low"
"src/pcl/macros"
"src/pcl/compiler-support"
"src/pcl/low"
- ;; "src/pcl/fin" merged into "src/pcl/low" in 0.6.11.43
"src/pcl/defclass"
"src/pcl/defs"
"src/pcl/fngen"
;;; some DWIM "functionality".
(assert (raises-error? (format nil "~:2T")))
+;;; bug reported, with fix, by Robert Strandh, sbcl-devel 2002-03-09,
+;;; fixed in sbcl-0.7.1.36:
+(assert (string= (format nil "~2,3,8,'0$" 1234567.3d0) "1234567.30"))
+
+;;; checks that other FORMAT-DOLLAR output remains sane after the
+;;; 0.7.1.36 change
+(assert (string= (format nil "~$" 0) "0.00"))
+(assert (string= (format nil "~$" 4) "4.00"))
+(assert (string= (format nil "~$" -4.0) "-4.00"))
+(assert (string= (format nil "~2,7,11$" -4.0) "-0000004.00"))
+(assert (string= (format nil "~2,7,11,' $" 1.1) " 0000001.10"))
+(assert (string= (format nil "~1,7,11,' $" 1.1) " 0000001.1"))
+(assert (string= (format nil "~1,3,8,' $" 7.3) " 007.3"))
+(assert (string= (format nil "~2,3,8,'0$" 7.3) "00007.30"))
+
;;; success
(quit :unix-status 104)
;;; for internal versions, especially for internal versions off the
;;; main CVS branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"0.7.1.35"
+"0.7.1.36"
projects / sbcl.git / commitdiff