X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Ftarget-format.lisp;h=f8ab91fdf967e361e6e39a5b742cad02557ce4d3;hb=6129b1ebc5125c57d6446c061155f5f653f41725;hp=a5ef5e6eb44cded3f631e9a782ac514db774ed6a;hpb=8f1d4a2508e8d81564822a1668fe30a490b9c3f6;p=sbcl.git diff --git a/src/code/target-format.lisp b/src/code/target-format.lisp index a5ef5e6..f8ab91f 100644 --- a/src/code/target-format.lisp +++ b/src/code/target-format.lisp @@ -170,6 +170,14 @@ ;;;; format interpreters and support functions for simple output (defun format-write-field (stream string mincol colinc minpad padchar padleft) + (when (and colinc (<= colinc 0)) + (error 'format-error + :complaint "The value of colinc is ~a, should be a positive integer" + :args (list colinc))) + (when (and mincol (< mincol 0)) + (error 'format-error + :complaint "The value of mincol is ~a, should be a non-negative integer" + :args (list mincol))) (unless padleft (write-string string stream)) (dotimes (i minpad) @@ -226,11 +234,17 @@ (def-format-interpreter #\C (colonp atsignp params) (interpret-bind-defaults () params - (if colonp - (format-print-named-character (next-arg) stream) - (if atsignp - (prin1 (next-arg) stream) - (write-char (next-arg) stream))))) + (let ((arg (next-arg))) + (unless (typep arg 'character) + (error 'format-error + :complaint "~s is not of type CHARACTER." + :args (list arg))) + (cond (colonp + (format-print-named-character arg stream)) + (atsignp + (prin1 arg stream)) + (t + (write-char arg stream)))))) ;;; "printing" as defined in the ANSI CL glossary, which is normative. (defun char-printing-p (char) @@ -318,6 +332,11 @@ (commainterval 3)) params (let ((arg (next-arg))) + (unless (or base + (integerp arg)) + (error 'format-error + :complaint "~s is not of type INTEGER." + :args (list arg))) (if base (format-print-integer stream arg colonp atsignp base mincol padchar commachar commainterval) @@ -752,9 +771,10 @@ :complaint "cannot specify either colon or atsign for this directive")) (interpret-bind-defaults ((count 1)) params - (fresh-line stream) - (dotimes (i (1- count)) - (terpri stream)))) + (when (plusp count) + (fresh-line stream) + (dotimes (i (1- count)) + (terpri stream))))) (def-format-interpreter #\| (colonp atsignp params) (when (or colonp atsignp)