Remove a style-warning from sb-bsd-sockets.asd when #-sb-testing-contrib.

[sbcl.git] / src / code / target-format.lisp

diff --git a/src/code/target-format.lisp b/src/code/target-format.lisp
index 6419712..f8ab91f 100644 (file)
--- 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)
@@ -622,14 +641,6 @@
                   (when (and d (zerop d)) (setq tpoint nil))
                   (when w
                     (decf spaceleft flen)
-                    ;; See CLHS 22.3.3.2.  "If the parameter d is
-                    ;; omitted, ... [and] if the fraction to be
-                    ;; printed is zero then a single zero digit should
-                    ;; appear after the decimal point."  So we need to
-                    ;; subtract one from here because we're going to
-                    ;; add an extra 0 digit later. [rtoy]
-                    (when (and (zerop number) (null d))
-                      (decf spaceleft))
                     (when lpoint
                       (if (or (> spaceleft 0) tpoint)
                           (decf spaceleft)
@@ -646,10 +657,6 @@
                                (if atsign (write-char #\+ stream)))
                            (when lpoint (write-char #\0 stream))
                            (write-string fstr stream)
-                           (when (and (zerop number) (null d))
-                             ;; It's later and we're adding the zero
-                             ;; digit.
-                             (write-char #\0 stream))
                            (write-char (if marker
                                            marker
                                            (format-exponent-marker number))
@@ -764,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)