X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Ftarget-format.lisp;h=3e62ac0f253e2c5d280077ebf27866cbfa232b0c;hb=bee53328c93be3433477821131ab805557476c8b;hp=78001b916ba15dc0d00192aa889fbeb75578d2ad;hpb=79953929196409f21fe505b29b15d2a9281884b7;p=sbcl.git

diff --git a/src/code/target-format.lisp b/src/code/target-format.lisp
index 78001b9..3e62ac0 100644
--- a/src/code/target-format.lisp
+++ b/src/code/target-format.lisp
@@ -120,14 +120,10 @@
        (defun ,defun-name (stream ,directive ,directives orig-args args)
 	 (declare (ignorable stream orig-args args))
 	 ,@(if lambda-list
-	       `((let ,(mapcar #'(lambda (var)
-				   `(,var
-				     (,(intern (concatenate
-						'string
-						"FORMAT-DIRECTIVE-"
-						(symbol-name var))
-					       (symbol-package 'foo))
-				      ,directive)))
+	       `((let ,(mapcar (lambda (var)
+				 `(,var
+				   (,(symbolicate "FORMAT-DIRECTIVE-" var)
+				    ,directive)))
 			       (butlast lambda-list))
 		   (values (progn ,@body) args)))
 	       `((declare (ignore ,directive ,directives))
@@ -171,10 +167,15 @@
     (write-string string stream))
   (dotimes (i minpad)
     (write-char padchar stream))
-  (do ((chars (+ (length string) minpad) (+ chars colinc)))
-      ((>= chars mincol))
-    (dotimes (i colinc)
-      (write-char padchar stream)))
+  ;; As of sbcl-0.6.12.34, we could end up here when someone tries to
+  ;; print e.g. (FORMAT T "~F" "NOTFLOAT"), in which case ANSI says
+  ;; 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)))
+	((>= chars mincol))
+      (dotimes (i colinc)
+	(write-char padchar stream))))
   (when padleft
     (write-string string stream)))