From f72068cbd31569f6e64b8d6261a27a69560da91a Mon Sep 17 00:00:00 2001 From: rtoy <rtoy> Date: Tue, 31 Aug 2004 12:48:20 +0000 Subject: [PATCH] Fix for some ansi-tests. o format.r.8: (format nil "~vr" nil 5) is supposed to print "five", not "5". o format.logical-block.23: ~<...~:@> is supposed to add fill-style conditional newlines after each group of blanks in the body, EXCEPT for blanks after a <Newline> directive. --- code/format.lisp | 32 ++++++++++++++++++++------------ 1 file changed, 20 insertions(+), 12 deletions(-) diff --git a/code/format.lisp b/code/format.lisp index dea70e4af..aa1b9c603 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.53 2004/08/27 11:31:54 rtoy Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/format.lisp,v 1.54 2004/08/31 12:48:20 rtoy Exp $") ;;; ;;; ********************************************************************** ;;; @@ -826,11 +826,13 @@ (def-format-interpreter #\R (colonp atsignp params) (if params (interpret-bind-defaults - ((base 10) (mincol 0) (padchar #\space) (commachar #\,) + ((base nil) (mincol 0) (padchar #\space) (commachar #\,) (commainterval 3)) params - (format-print-integer stream (next-arg) colonp atsignp base mincol - padchar commachar commainterval)) + (if base + (format-print-integer stream (next-arg) colonp atsignp base mincol + padchar commachar commainterval) + (format-print-cardinal stream (next-arg)))) (if atsignp (if colonp (format-print-old-roman stream (next-arg)) @@ -2317,21 +2319,26 @@ insides suffix))) -(defun add-fill-style-newlines (list string offset) +;; CLHS 22.3.5.2 says fill-style conditional newlines are +;; automatically inserted after each group of blanks except for blanks +;; after a newline directive. +(defun add-fill-style-newlines (list string offset &optional newlinep) (if list (let ((directive (car list))) (if (simple-string-p directive) - (nconc (add-fill-style-newlines-aux directive string offset) + (nconc (add-fill-style-newlines-aux directive string offset newlinep) (add-fill-style-newlines (cdr list) string (+ offset (length directive)))) (cons directive (add-fill-style-newlines (cdr list) string - (format-directive-end directive))))) + (format-directive-end directive) + (char= (format-directive-character directive) + #\Newline))))) nil)) -(defun add-fill-style-newlines-aux (literal string offset) +(defun add-fill-style-newlines-aux (literal string offset &optional newlinep) (let ((end (length literal)) (posn 0)) (collect ((results)) @@ -2344,10 +2351,11 @@ :test #'char/=) end))) (results (subseq literal posn non-blank)) - (results (make-format-directive - :string string :character #\_ - :start (+ offset non-blank) :end (+ offset non-blank) - :colonp t :atsignp nil :params nil)) + (unless newlinep + (results (make-format-directive + :string string :character #\_ + :start (+ offset non-blank) :end (+ offset non-blank) + :colonp t :atsignp nil :params nil))) (setf posn non-blank)) (when (= posn end) (return)))) -- GitLab