X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Ftarget-format.lisp;h=a31bc5166c785438d8c2dbf86a8c83c61fd1813e;hb=15d6e7c9a2c3234f95dfe278046fa2fee1b0c007;hp=bc9090779387fee12979f04f0f7126b801e5d278;hpb=1d5e0a5293d69aa29c8c7b72cda555478622e913;p=sbcl.git

diff --git a/src/code/target-format.lisp b/src/code/target-format.lisp
index bc90907..a31bc51 100644
--- a/src/code/target-format.lisp
+++ b/src/code/target-format.lisp
@@ -145,7 +145,7 @@
 				  (offset (car param-and-offset))
 				  (param (cdr param-and-offset)))
 			     (case param
-			       (:arg (next-arg offset))
+			       (:arg (or (next-arg offset) ,default))
 			       (:remaining (length args))
 			       ((nil) ,default)
 			       (t param)))))))
@@ -172,7 +172,7 @@
   ;; we're supposed to soldier on bravely, and so we have to deal with
   ;; the unsupplied-MINCOL-and-COLINC case without blowing up.
   (when (and mincol colinc)
-    (do ((chars (+ (length string) minpad) (+ chars colinc)))
+    (do ((chars (+ (length string) (max minpad 0)) (+ chars colinc)))
 	((>= chars mincol))
       (dotimes (i colinc)
 	(write-char padchar stream))))
@@ -235,8 +235,8 @@
 (def-format-interpreter #\W (colonp atsignp params)
   (interpret-bind-defaults () params
     (let ((*print-pretty* (or colonp *print-pretty*))
-	  (*print-level* (and atsignp *print-level*))
-	  (*print-length* (and atsignp *print-length*)))
+	  (*print-level* (unless atsignp *print-level*))
+	  (*print-length* (unless atsignp *print-length*)))
       (output-object (next-arg) stream))))
 
 ;;;; format interpreters and support functions for integer output
@@ -1022,8 +1022,8 @@
 			  (*logical-block-popper* nil)
 			  (*outside-args* args))
 		     (catch 'up-and-out
-		       (do-guts arg arg)
-		       args))
+		       (do-guts arg arg))
+                     args)
 		   (do-guts orig-args args)))
 	     (do-loop (orig-args args)
 	       (catch (if colonp 'up-up-and-out 'up-and-out)
@@ -1067,7 +1067,8 @@
 		  ;; situation.
 		  (error 'format-error
 			 :complaint "~D illegal directive~:P found inside justification block"
-			 :args (list count)))
+			 :args (list count)
+                         :references (list '(:ansi-cl :section (22 3 5 2)))))
 		(interpret-format-justification stream orig-args args
 						segments colonp atsignp
 						first-semi params))))
@@ -1112,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)))
@@ -1124,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)