0.pre7.68:

[sbcl.git] / src / code / target-format.lisp

diff --git a/src/code/target-format.lisp b/src/code/target-format.lisp
index e362550..a129f24 100644 (file)
--- 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)))
 
@@ -229,7 +230,10 @@
     (cond (name
           (write-string (string-capitalize name) stream))
          ((<= 0 (char-code char) 31)
-          ;; Print control characters as "^"<char>
+          ;; Print control characters as "^"<char>. (This seems to be
+          ;; old pre-ANSI behavior, but ANSI just says that the "#^"
+          ;; sequence is undefined and not reserved for the user, so
+          ;; this behavior should be ANSI-compliant.)
           (write-char #\^ stream)
           (write-char (code-char (+ 64 (char-code char))) stream))
          (t
@@ -1154,7 +1158,7 @@
 ;;;; format interpreter and support functions for user-defined method
 
 (def-format-interpreter #\/ (string start end colonp atsignp params)
-  (let ((symbol (extract-user-function-name string start end)))
+  (let ((symbol (extract-user-fun-name string start end)))
     (collect ((args))
       (dolist (param-and-offset params)
        (let ((param (cdr param-and-offset)))