0.8.16.39:

        * Fix bug in ~^: parameter equal to NIL should mean
          "unsupplied" (found by PFD's test suite).

diff --git a/NEWS b/NEWS
index fba5f66..3e4504c 100644 (file)
--- a/NEWS
+++ b/NEWS
@@ -63,6 +63,8 @@ changes in sbcl-0.8.17 relative to sbcl-0.8.16:
        point ranges without signalling FLOATING-POINT-OVERFLOW.
     ** Functions with IR1-transformations can create intercomponent
        references to global functions.
+    ** NIL parameter to the FORMAT directive ~^ means `unsupplied
+       parameter'.
 
 changes in sbcl-0.8.16 relative to sbcl-0.8.15:
   * enhancement: saving cores with foreign code loaded is now

diff --git a/src/code/late-format.lisp b/src/code/late-format.lisp
index 4cb042a..dd301e0 100644 (file)
--- a/src/code/late-format.lisp
+++ b/src/code/late-format.lisp
@@ -905,18 +905,15 @@
   (when (and colonp (not *up-up-and-out-allowed*))
     (error 'format-error
           :complaint "attempt to use ~~:^ outside a ~~:{...~~} construct"))
-  `(when ,(case (length params)
-           (0 (if colonp
-                  '(null outside-args)
-                  (progn
-                    (setf *only-simple-args* nil)
-                    '(null args))))
-           (1 (expand-bind-defaults ((count 0)) params
-                `(zerop ,count)))
-           (2 (expand-bind-defaults ((arg1 0) (arg2 0)) params
-                `(= ,arg1 ,arg2)))
-           (t (expand-bind-defaults ((arg1 0) (arg2 0) (arg3 0)) params
-                `(<= ,arg1 ,arg2 ,arg3))))
+  `(when ,(expand-bind-defaults ((arg1 nil) (arg2 nil) (arg3 nil)) params
+            `(cond (,arg3 (<= ,arg1 ,arg2 ,arg3))
+                   (,arg2 (eql ,arg1 ,arg2))
+                   (,arg1 (eql ,arg1 0))
+                   (t ,(if colonp
+                           '(null outside-args)
+                           (progn
+                             (setf *only-simple-args* nil)
+                             '(null args))))))
      ,(if colonp
          '(return-from outside-loop nil)
          '(return))))

diff --git a/src/code/target-format.lisp b/src/code/target-format.lisp
index 26616bc..d5e6911 100644 (file)
--- a/src/code/target-format.lisp
+++ b/src/code/target-format.lisp
@@ -973,16 +973,13 @@
   (when (and colonp (not *up-up-and-out-allowed*))
     (error 'format-error
           :complaint "attempt to use ~~:^ outside a ~~:{...~~} construct"))
-  (when (case (length params)
-         (0 (if colonp
-                (null *outside-args*)
-                (null args)))
-         (1 (interpret-bind-defaults ((count 0)) params
-              (zerop count)))
-         (2 (interpret-bind-defaults ((arg1 0) (arg2 0)) params
-              (= arg1 arg2)))
-         (t (interpret-bind-defaults ((arg1 0) (arg2 0) (arg3 0)) params
-              (<= arg1 arg2 arg3))))
+  (when (interpret-bind-defaults ((arg1 nil) (arg2 nil) (arg3 nil)) params
+          (cond (arg3 (<= arg1 arg2 arg3))
+                (arg2 (eql arg1 arg2))
+                (arg1 (eql arg1 0))
+                (t (if colonp
+                       (null *outside-args*)
+                       (null args)))))
     (throw (if colonp 'up-up-and-out 'up-and-out)
           args)))
 \f

diff --git a/tests/print.impure.lisp b/tests/print.impure.lisp
index 9d9fd62..032f90b 100644 (file)
--- a/tests/print.impure.lisp
+++ b/tests/print.impure.lisp
@@ -298,5 +298,16 @@
                                     (princ-to-string r)))))))))
        (write-char #\.)
        (finish-output)))
+
+;;;; Bugs, found by PFD
+;;; NIL parameter for ~^ means `not supplied'
+(loop for (format arg result) in
+      '(("~:{~D~v^~D~}" ((3 1 4) (1 0 2) (7 nil) (5 nil 6)) "341756")
+        ("~:{~1,2,v^~A~}" ((nil 0) (3 1) (0 2)) "02"))
+      do (assert (string= (funcall #'format nil format arg) result))
+      do (assert (string= (with-output-to-string (s)
+                            (funcall (eval `(formatter ,format)) s arg))
+                          result)))
+
 ;;; success
 (quit :unix-status 104)

diff --git a/version.lisp-expr b/version.lisp-expr
index 057d329..02defec 100644 (file)
--- a/version.lisp-expr
+++ b/version.lisp-expr
@@ -17,4 +17,4 @@
 ;;; checkins which aren't released. (And occasionally for internal
 ;;; versions, especially for internal versions off the main CVS
 ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"0.8.16.38"
+"0.8.16.39"