X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Ftarget-format.lisp;h=3406f9b9bd41ac9bf64803bfd1941156f5b97ca4;hb=11aa29a68039d6fb3cf41d67352a6b263b1094b6;hp=7ed2b55a1ff25bc46b327280584144e6de797a81;hpb=b894cb41d869bda6ba0c54a491becc7bb58375c1;p=sbcl.git

diff --git a/src/code/target-format.lisp b/src/code/target-format.lisp
index 7ed2b55..3406f9b 100644
--- a/src/code/target-format.lisp
+++ b/src/code/target-format.lisp
@@ -234,11 +234,17 @@
 
 (def-format-interpreter #\C (colonp atsignp params)
   (interpret-bind-defaults () params
-    (if colonp
-        (format-print-named-character (next-arg) stream)
-        (if atsignp
-            (prin1 (next-arg) stream)
-            (write-char (next-arg) stream)))))
+    (let ((arg (next-arg)))
+      (unless (typep arg 'character)
+        (error 'format-error
+               :complaint "~s is not of type CHARACTER."
+               :args (list arg)))
+      (cond (colonp
+             (format-print-named-character arg stream))
+            (atsignp
+             (prin1 arg stream))
+            (t
+             (write-char arg stream))))))
 
 ;;; "printing" as defined in the ANSI CL glossary, which is normative.
 (defun char-printing-p (char)
@@ -326,6 +332,11 @@
        (commainterval 3))
       params
     (let ((arg (next-arg)))
+      (unless (or base
+                  (integerp arg))
+        (error 'format-error
+               :complaint "~s is not of type INTEGER."
+               :args (list arg)))
       (if base
           (format-print-integer stream arg colonp atsignp base mincol
                                 padchar commachar commainterval)
@@ -1089,7 +1100,7 @@
   (multiple-value-bind (segments first-semi close remaining)
       (parse-format-justification directives)
     (setf args
-          (if (format-directive-colonp close)
+          (if (format-directive-colonp close) ; logical block vs. justification
               (multiple-value-bind (prefix per-line-p insides suffix)
                   (parse-format-logical-block segments colonp first-semi
                                               close params string end)
@@ -1104,6 +1115,16 @@
                          :complaint "~D illegal directive~:P found inside justification block"
                          :args (list count)
                          :references (list '(:ansi-cl :section (22 3 5 2)))))
+                ;; ANSI does not explicitly say that an error should
+                ;; be signalled, but the @ modifier is not explicitly
+                ;; allowed for ~> either.
+                (when (format-directive-atsignp close)
+                  (error 'format-error
+                         :complaint "@ modifier not allowed in close ~
+                         directive of justification ~
+                         block (i.e. ~~<...~~@>."
+                         :offset (1- (format-directive-end close))
+                         :references (list '(:ansi-cl :section (22 3 6 2)))))
                 (interpret-format-justification stream orig-args args
                                                 segments colonp atsignp
                                                 first-semi params))))