X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Flate-format.lisp;h=a7f32f747421af1ef6036d9a74398d42f357a3a8;hb=1d5e0a5293d69aa29c8c7b72cda555478622e913;hp=9063fa4b2f32f5bcc21705cbe578a8ceddbac7d0;hpb=8097f555eb90f15c51b96e20bd88db15757247b9;p=sbcl.git

diff --git a/src/code/late-format.lisp b/src/code/late-format.lisp
index 9063fa4..a7f32f7 100644
--- a/src/code/late-format.lisp
+++ b/src/code/late-format.lisp
@@ -225,7 +225,8 @@
        (if expander
 	   (funcall expander directive more-directives)
 	   (error 'format-error
-		  :complaint "unknown directive"))))
+		  :complaint "unknown directive ~@[(character: ~A)~]"
+		  :args (list (char-name (format-directive-character directive)))))))
     (simple-string
      (values `(write-string ,directive stream)
 	     more-directives))))
@@ -948,6 +949,23 @@
 
 ;;;; format directives and support functions for justification
 
+(defparameter *illegal-inside-justification*
+  (mapcar (lambda (x) (parse-directive x 0))
+	  '("~W" "~:W" "~@W" "~:@W"
+	    "~_" "~:_" "~@_" "~:@_"
+	    "~:>" "~:@>"
+	    "~I" "~:I" "~@I" "~:@I"
+	    "~:T" "~:@T")))
+
+(defun illegal-inside-justification-p (directive)
+  (member directive *illegal-inside-justification*
+	  :test (lambda (x y)
+		  (and (format-directive-p x)
+		       (format-directive-p y)
+		       (eql (format-directive-character x) (format-directive-character y))
+		       (eql (format-directive-colonp x) (format-directive-colonp y))
+		       (eql (format-directive-atsignp x) (format-directive-atsignp y))))))
+
 (def-complex-format-directive #\< (colonp atsignp params string end directives)
   (multiple-value-bind (segments first-semi close remaining)
       (parse-format-justification directives)
@@ -958,8 +976,15 @@
 					 close params string end)
 	   (expand-format-logical-block prefix per-line-p insides
 					suffix atsignp))
-	 (expand-format-justification 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)))
+	   (expand-format-justification segments colonp atsignp
+				      first-semi params)))
      remaining)))
 
 (def-complex-format-directive #\> ()