From 072200bd6b39dc237e087c212a38b859c688b5e2 Mon Sep 17 00:00:00 2001 From: toy <toy> Date: Tue, 15 Oct 2002 15:50:24 +0000 Subject: [PATCH] Port over SBCL's fix for the Entomotomy bug format-logical-block-bad-directive-error-signalling that says an error is signalled if ~W, ~_, ~<...~:>, ~I, or ~:T is used inside "~<..~>" (without the colon modifier on the closing syntax). We signal errors now. --- code/format.lisp | 43 +++++++++++++++++++++++++++++++++++++------ 1 file changed, 37 insertions(+), 6 deletions(-) diff --git a/code/format.lisp b/code/format.lisp index 8906f9161..34d546f1c 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.44 2002/03/14 11:50:13 pmai Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/format.lisp,v 1.45 2002/10/15 15:50:24 toy Exp $") ;;; ;;; ********************************************************************** ;;; @@ -2064,6 +2064,23 @@ ;;;; 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) @@ -2076,8 +2093,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 (apply #'+ (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" + :arguments (list count))) + (expand-format-justification segments colonp atsignp + first-semi params))) remaining))) (def-complex-format-interpreter #\< @@ -2094,9 +2118,16 @@ (interpret-format-logical-block stream orig-args args prefix per-line-p insides suffix atsignp)) - (interpret-format-justification stream orig-args args - segments colonp atsignp - first-semi params))) + (let ((count (apply #'+ (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" + :arguments (list count))) + (interpret-format-justification stream orig-args args + segments colonp atsignp + first-semi params)))) remaining)) (defun parse-format-justification (directives) -- GitLab