From a5dc4619c59efd346b967ec89cd989188a3cf751 Mon Sep 17 00:00:00 2001
From: Alexey Dejneka <adejneka@comail.ru>
Date: Mon, 15 Nov 2004 19:25:47 +0000
Subject: [PATCH] 0.8.16.39:         * Fix bug in ~^: parameter equal to NIL
 should mean           "unsupplied" (found by PFD's test suite).

---
 NEWS                        |  2 ++
 src/code/late-format.lisp   | 21 +++++++++------------
 src/code/target-format.lisp | 17 +++++++----------
 tests/print.impure.lisp     | 11 +++++++++++
 version.lisp-expr           |  2 +-
 5 files changed, 30 insertions(+), 23 deletions(-)

diff --git a/NEWS b/NEWS
index fba5f6633..3e4504c1b 100644
--- 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 4cb042a69..dd301e05e 100644
--- 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 26616bcc5..d5e6911a5 100644
--- 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)))
 
diff --git a/tests/print.impure.lisp b/tests/print.impure.lisp
index 9d9fd6246..032f90b11 100644
--- 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 057d3297a..02defec22 100644
--- 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"
-- 
2.11.4.GIT