X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Flate-format.lisp;h=4f4c6b12d933316af214b491f25ad5e2c8005878;hb=0f3a5f2e8886d18d0b4f6485c38a42be629422ae;hp=9afc2a570460e7c4305b4d9037e427356aaff85b;hpb=6f4c867e670a3c538b4072b824fa8026e9f2cbfe;p=sbcl.git

diff --git a/src/code/late-format.lisp b/src/code/late-format.lisp
index 9afc2a5..4f4c6b1 100644
--- a/src/code/late-format.lisp
+++ b/src/code/late-format.lisp
@@ -513,7 +513,8 @@
       params
     (let ((n-arg (sb!xc:gensym "ARG")))
       `(let ((,n-arg ,(expand-next-arg)))
-         (unless (integerp ,n-arg)
+         (unless (or ,base
+                     (integerp ,n-arg))
            (error 'format-error
                   :complaint "~s is not of type INTEGER."
                   :args (list ,n-arg)
@@ -1048,7 +1049,7 @@
   (multiple-value-bind (segments first-semi close remaining)
       (parse-format-justification directives)
     (values
-     (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)
@@ -1062,6 +1063,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)))))
            (expand-format-justification segments colonp atsignp
                                         first-semi params)))
      remaining)))