From 2ce0d24b6307634ddf111ba902241edef95445df Mon Sep 17 00:00:00 2001 From: rtoy <rtoy> Date: Tue, 31 Aug 2004 16:31:43 +0000 Subject: [PATCH] Catch uses of ~<...~:;...~> form of ~<...~> in the same format string as ~W, ~_, ~<...~:>, ~I, or ~:T. This should signal an error, according to CLHS 22.3.5.2. --- code/format.lisp | 46 +++++++++++++++++++++++++++++++++++++++++++--- 1 file changed, 43 insertions(+), 3 deletions(-) diff --git a/code/format.lisp b/code/format.lisp index aa1b9c603..d6e8d20bc 100644 --- a/code/format.lisp +++ b/code/format.lisp @@ -5,7 +5,7 @@ ;;; Carnegie Mellon University, and has been placed in the public domain. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/format.lisp,v 1.54 2004/08/31 12:48:20 rtoy Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/format.lisp,v 1.55 2004/08/31 16:31:43 rtoy Exp $") ;;; ;;; ********************************************************************** ;;; @@ -78,16 +78,56 @@ (declare (simple-string string)) (let ((index 0) (end (length string)) - (result nil)) + (result nil) + (in-block nil) + (pprint nil) + (semi nil) + (justification-semi 0)) (loop (let ((next-directive (or (position #\~ string :start index) end))) (when (> next-directive index) (push (subseq string index next-directive) result)) (when (= next-directive end) (return)) - (let ((directive (parse-directive string next-directive))) + (let* ((directive (parse-directive string next-directive)) + (directive-char (format-directive-character directive))) + ;; We are looking for illegal combinations of format + ;; directives in the control string. See the last paragraph + ;; of CLHS 22.3.5.2: "an error is also signaled if the + ;; ~<...~:;...~> form of ~<...~> is used in the same format + ;; string with ~W, ~_, ~<...~:>, ~I, or ~:T." + (cond ((char= #\< directive-char) + ;; Found a justification or logical block + (setf in-block t)) + ((and in-block (char= #\; directive-char)) + ;; Found a semi colon in a justification or logical block + (setf semi t)) + ((char= #\> directive-char) + ;; End of justification or logical block. Figure out which. + (setf in-block nil) + (cond ((format-directive-colonp directive) + ;; A logical-block directive. Note that fact, and also + ;; note that we don't care if we found any ~; + ;; directives in the block. + (setf pprint t) + (setf semi nil)) + (semi + ;; A justification block with a ~; directive in it. + (incf justification-semi)))) + ((and (not in-block) + (or (and (char= #\T directive-char) (format-directive-colonp directive)) + (char= #\W directive-char) + (char= #\_ directive-char) + (char= #\I directive-char))) + (setf pprint t))) (push directive result) (setf index (format-directive-end directive))))) + (when (and pprint (plusp justification-semi)) + (error 'format-error + :complaint "A justification directive cannot be in the same format string~%~ + as ~~W, ~~I, ~~:T, or a logical-block directive." + :control-string string + :offset 0)) (nreverse result))) (defun parse-directive (string start) -- GitLab