0.8.15.11:

	Fix ~< justification directive (patch essentially that applied
	by rtoy for cmucl 2004-08-27)

diff --git a/NEWS b/NEWS
index 33bd0ce..06d43e5 100644 (file)
--- a/NEWS
+++ b/NEWS
@@ -21,6 +21,8 @@ changes in sbcl-0.8.16 relative to sbcl-0.8.15:
     ** PPRINT-INDENT accepts a request for an indentation of any REAL.
     ** PPRINT-TAB (and the FORMAT ~T directive) now indent by the
        correct amounts.
+    ** The justification version of the FORMAT ~< directive treats
+       non-zero minpad parameter correctly.
 
 changes in sbcl-0.8.15 relative to sbcl-0.8.14:
   * incompatible change: SB-INT:*BEFORE-SAVE-INITIALIZATIONS* and

diff --git a/src/code/target-format.lisp b/src/code/target-format.lisp
index 3860132..a31bc51 100644 (file)
--- a/src/code/target-format.lisp
+++ b/src/code/target-format.lisp
@@ -1113,8 +1113,6 @@
 (defun format-justification (stream newline-prefix extra-space line-len strings
                             pad-left pad-right mincol colinc minpad padchar)
   (setf strings (reverse strings))
-  (when (and (not pad-left) (not pad-right) (null (cdr strings)))
-    (setf pad-left t))
   (let* ((num-gaps (+ (1- (length strings))
                      (if pad-left 1 0)
                      (if pad-right 1 0)))
@@ -1125,18 +1123,19 @@
         (length (if (> chars mincol)
                     (+ mincol (* (ceiling (- chars mincol) colinc) colinc))
                     mincol))
-        (padding (- length chars)))
+        (padding (+ (- length chars) (* num-gaps minpad))))
     (when (and newline-prefix
               (> (+ (or (sb!impl::charpos stream) 0)
                     length extra-space)
                  line-len))
       (write-string newline-prefix stream))
     (flet ((do-padding ()
-            (let ((pad-len (truncate padding num-gaps)))
+            (let ((pad-len
+                    (if (zerop num-gaps) padding (truncate padding num-gaps))))
               (decf padding pad-len)
               (decf num-gaps)
               (dotimes (i pad-len) (write-char padchar stream)))))
-      (when pad-left
+      (when (or pad-left (and (not pad-right) (null (cdr strings))))
        (do-padding))
       (when strings
        (write-string (car strings) stream)

diff --git a/version.lisp-expr b/version.lisp-expr
index c873ecc..53e4018 100644 (file)
--- a/version.lisp-expr
+++ b/version.lisp-expr
@@ -17,4 +17,4 @@
 ;;; checkins which aren't released. (And occasionally for internal
 ;;; versions, especially for internal versions off the main CVS
 ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"0.8.15.10"
+"0.8.15.11"