0.7.11.10:

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

diff --git a/src/code/target-format.lisp b/src/code/target-format.lisp
index 610d645..bc90907 100644 (file)
--- a/src/code/target-format.lisp
+++ b/src/code/target-format.lisp
@@ -74,15 +74,16 @@
           (interpret-directive-list stream (cdr directives) orig-args args))
          (format-directive
           (multiple-value-bind (new-directives new-args)
-              (let ((function
-                     (svref *format-directive-interpreters*
-                            (char-code (format-directive-character
-                                        directive))))
-                    (*default-format-error-offset*
-                     (1- (format-directive-end directive))))
+              (let* ((character (format-directive-character directive))
+                     (function
+                      (svref *format-directive-interpreters*
+                             (char-code character)))
+                     (*default-format-error-offset*
+                      (1- (format-directive-end directive))))
                 (unless function
                   (error 'format-error
-                         :complaint "unknown format directive"))
+                         :complaint "unknown format directive ~@[(character: ~A)~]"
+                         :args (list (char-name character))))
                 (multiple-value-bind (new-directives new-args)
                     (funcall function stream directive
                              (cdr directives) orig-args args)
@@ -228,13 +229,6 @@
   (let* ((name (char-name char)))
     (cond (name
           (write-string (string-capitalize name) stream))
-         ((<= 0 (char-code char) 31)
-          ;; 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
           (write-char char stream)))))
 
@@ -576,7 +570,7 @@
 ;;; errors. As for now, we let the user get away with it, and merely guarantee
 ;;; that at least one significant digit will appear.
 
-;;; toy@rtp.ericsson.se:  The Hyperspec seems to say that the exponent
+;;; Raymond Toy writes: The Hyperspec seems to say that the exponent
 ;;; marker is always printed. Make it so. Also, the original version
 ;;; causes errors when printing infinities or NaN's. The Hyperspec is
 ;;; silent here, so let's just print out infinities and NaN's instead
@@ -651,7 +645,7 @@
                                  w 1 0 #\space t)))
       (format-princ stream number nil nil w 1 0 pad)))
 
-;;; toy@rtp.ericsson.se:  Same change as for format-exp-aux.
+;;; Raymond Toy writes: same change as for format-exp-aux
 (defun format-general-aux (stream number w d e k ovf pad marker atsign)
   (if (and (floatp number)
           (or (float-infinity-p number)
@@ -687,24 +681,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)))
 \f
-;;;; 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)
@@ -1059,9 +1061,16 @@
                (interpret-format-logical-block stream orig-args args
                                                prefix per-line-p insides
                                                suffix atsignp))
-             (interpret-format-justification stream orig-args args
-                                             segments colonp atsignp
-                                             first-semi params)))
+             (let ((count (reduce #'+ (mapcar (lambda (x) (count-if #'illegal-inside-justification-p x)) segments))))
+               (when (> count 0)
+                 ;; ANSI specifies that "an error is signalled" in this
+                 ;; situation.
+                 (error 'format-error
+                        :complaint "~D illegal directive~:P found inside justification block"
+                        :args (list count)))
+               (interpret-format-justification stream orig-args args
+                                               segments colonp atsignp
+                                               first-semi params))))
     remaining))
 
 (defun interpret-format-justification