X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Flate-format.lisp;h=9063fa4b2f32f5bcc21705cbe578a8ceddbac7d0;hb=86210c4e406c1b2ff10cc3bac0e71435867db48b;hp=998468b1ba9461c855218d696b8d9c753656ebd0;hpb=e0814eee6f6dea52db010b45a330100f2fe65832;p=sbcl.git

diff --git a/src/code/late-format.lisp b/src/code/late-format.lisp
index 998468b..9063fa4 100644
--- a/src/code/late-format.lisp
+++ b/src/code/late-format.lisp
@@ -11,7 +11,7 @@
 
 (define-condition format-error (error)
   ((complaint :reader format-error-complaint :initarg :complaint)
-   (arguments :reader format-error-arguments :initarg :arguments :initform nil)
+   (args :reader format-error-args :initarg :args :initform nil)
    (control-string :reader format-error-control-string
 		   :initarg :control-string
 		   :initform *default-format-error-control-string*)
@@ -27,7 +27,7 @@
 		 ~?~@[~%  ~A~%  ~V@T^~]"
 	  (format-error-print-banner condition)
 	  (format-error-complaint condition)
-	  (format-error-arguments condition)
+	  (format-error-args condition)
 	  (format-error-control-string condition)
 	  (format-error-offset condition)))
 
@@ -73,10 +73,17 @@
 			:complaint "String ended before directive was found."
 			:control-string string
 			:offset start)
-		 (schar string posn))))
+		 (schar string posn)))
+	   (check-ordering ()
+	     (when (or colonp atsignp)
+	       (error 'format-error
+		      :complaint "parameters found after #\\: or #\\@ modifier"
+		      :control-string string
+		      :offset posn))))
       (loop
 	(let ((char (get-char)))
 	  (cond ((or (char<= #\0 char #\9) (char= char #\+) (char= char #\-))
+		 (check-ordering)
 		 (multiple-value-bind (param new-posn)
 		     (parse-integer string :start posn :junk-allowed t)
 		   (push (cons posn param) params)
@@ -87,7 +94,9 @@
 		      (decf posn))
 		     (t
 		      (return)))))
-		((or (char= char #\v) (char= char #\V))
+		((or (char= char #\v)
+		     (char= char #\V))
+		 (check-ordering)
 		 (push (cons posn :arg) params)
 		 (incf posn)
 		 (case (get-char)
@@ -97,6 +106,7 @@
 		   (t
 		    (return))))
 		((char= char #\#)
+		 (check-ordering)
 		 (push (cons posn :remaining) params)
 		 (incf posn)
 		 (case (get-char)
@@ -106,12 +116,14 @@
 		   (t
 		    (return))))
 		((char= char #\')
+		 (check-ordering)
 		 (incf posn)
 		 (push (cons posn (get-char)) params)
 		 (incf posn)
 		 (unless (char= (get-char) #\,)
 		   (decf posn)))
 		((char= char #\,)
+		 (check-ordering)
 		 (push (cons posn nil) params))
 		((char= char #\:)
 		 (if colonp
@@ -129,6 +141,7 @@
 		     (setf atsignp t)))
 		(t
 		 (when (char= (schar string (1- posn)) #\,)
+		   (check-ordering)
 		   (push (cons (1- posn) nil) params))
 		 (return))))
 	(incf posn))
@@ -264,7 +277,7 @@
 			      'format-error
 			      :complaint
 			      "too many parameters, expected no more than ~W"
-			      :arguments (list ,(length specs))
+			      :args (list ,(length specs))
 			      :offset (caar ,params)))
 		       ,,@body)))
 	`(progn
@@ -619,7 +632,7 @@
 		 (error 'format-error
 			:complaint "Index ~W out of bounds. Should have been ~
 				    between 0 and ~W."
-			:arguments (list ,posn (length orig-args))
+			:args (list ,posn (length orig-args))
 			:offset ,(1- end)))))
       (if colonp
 	  (expand-bind-defaults ((n 1)) params
@@ -636,8 +649,7 @@
 			       :complaint
 			       "Index ~W is out of bounds; should have been ~
 				between 0 and ~W."
-			       :arguments
-			       (list new-posn (length orig-args))
+			       :args (list new-posn (length orig-args))
 			       :offset ,(1- end)))))))
 	  (if params
 	      (expand-bind-defaults ((n 1)) params
@@ -659,7 +671,7 @@
 	     (error 'format-error
 		    :complaint
 		    "~A~%while processing indirect format string:"
-		    :arguments (list condition)
+		    :args (list condition)
 		    :print-banner nil
 		    :control-string ,string
 		    :offset ,(1- end)))))
@@ -871,7 +883,7 @@
 			       (error 'format-error
 				      :complaint
 			      "~A~%while processing indirect format string:"
-				      :arguments (list condition)
+				      :args (list condition)
 				      :print-banner nil
 				      :control-string ,string
 				      :offset ,(1- end)))))
@@ -970,7 +982,7 @@
 			      :complaint
 			      "cannot include format directives inside the ~
 			       ~:[suffix~;prefix~] segment of ~~<...~~:>"
-			      :arguments (list prefix-p)
+			      :args (list prefix-p)
 			      :offset (1- (format-directive-end directive)))
 		       (apply #'concatenate 'string list)))))
 	(case (length segments)
@@ -1146,8 +1158,8 @@
 				  ;; subseq expansion.
 				  (subseq foo (1+ slash) (1- end)))))
 	   (first-colon (position #\: name))
-	   (last-colon (if first-colon (position #\: name :from-end t)))
-	   (package-name (if last-colon
+	   (second-colon (if first-colon (position #\: name :start (1+ first-colon))))
+	   (package-name (if first-colon
 			     (subseq name 0 first-colon)
 			     "COMMON-LISP-USER"))
 	   (package (find-package package-name)))
@@ -1156,8 +1168,11 @@
 	;; FIND-UNDELETED-PACKAGE-OR-LOSE?
 	(error 'format-error
 	       :complaint "no package named ~S"
-	       :arguments (list package-name)))
-      (intern (if first-colon
-		  (subseq name (1+ first-colon))
-		  name)
+	       :args (list package-name)))
+      (intern (cond
+		((and second-colon (= second-colon (1+ first-colon)))
+		 (subseq name (1+ second-colon)))
+		(first-colon
+		 (subseq name (1+ first-colon)))
+		(t name))
 	      package))))