From 4aef4760057ae2f236418ef5fcb410f027961a18 Mon Sep 17 00:00:00 2001 From: William Harold Newman Date: Sat, 9 Mar 2002 19:10:38 +0000 Subject: [PATCH] 0.7.1.36: merged Robert Strandh "patch for format-dollars" (sbcl-devel 2002-03-09) --- src/code/target-format.lisp | 24 ++++++++++++++++-------- src/cold/chill.lisp | 6 +++--- src/cold/warm.lisp | 28 ++++++++++++++-------------- tests/print.impure.lisp | 15 +++++++++++++++ version.lisp-expr | 2 +- 5 files changed, 49 insertions(+), 26 deletions(-) diff --git a/src/code/target-format.lisp b/src/code/target-format.lisp index 610d645..b5e23c5 100644 --- a/src/code/target-format.lisp +++ b/src/code/target-format.lisp @@ -687,24 +687,32 @@ (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))) -;;;; 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) diff --git a/src/cold/chill.lisp b/src/cold/chill.lisp index 7158435..92b19c9 100644 --- a/src/cold/chill.lisp +++ b/src/cold/chill.lisp @@ -1,6 +1,6 @@ -;;;; 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 diff --git a/src/cold/warm.lisp b/src/cold/warm.lisp index 05c7539..4e5ca8e 100644 --- a/src/cold/warm.lisp +++ b/src/cold/warm.lisp @@ -64,17 +64,19 @@ ;;;; 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)) @@ -165,16 +167,14 @@ (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" diff --git a/tests/print.impure.lisp b/tests/print.impure.lisp index b636c37..c0064d1 100644 --- a/tests/print.impure.lisp +++ b/tests/print.impure.lisp @@ -48,5 +48,20 @@ ;;; 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) diff --git a/version.lisp-expr b/version.lisp-expr index 05813a2..4d77eb1 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -18,4 +18,4 @@ ;;; 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" -- 1.7.10.4