Skip to content
Snippets Groups Projects
Commit 2ce0d24b authored by rtoy's avatar rtoy
Browse files

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.
parent f72068cb
No related branches found
No related tags found
No related merge requests found
...@@ -5,7 +5,7 @@ ...@@ -5,7 +5,7 @@
;;; Carnegie Mellon University, and has been placed in the public domain. ;;; Carnegie Mellon University, and has been placed in the public domain.
;;; ;;;
(ext:file-comment (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 @@ ...@@ -78,16 +78,56 @@
(declare (simple-string string)) (declare (simple-string string))
(let ((index 0) (let ((index 0)
(end (length string)) (end (length string))
(result nil)) (result nil)
(in-block nil)
(pprint nil)
(semi nil)
(justification-semi 0))
(loop (loop
(let ((next-directive (or (position #\~ string :start index) end))) (let ((next-directive (or (position #\~ string :start index) end)))
(when (> next-directive index) (when (> next-directive index)
(push (subseq string index next-directive) result)) (push (subseq string index next-directive) result))
(when (= next-directive end) (when (= next-directive end)
(return)) (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) (push directive result)
(setf index (format-directive-end directive))))) (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))) (nreverse result)))
(defun parse-directive (string start) (defun parse-directive (string start)
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment