Skip to content

Commit

Permalink
0.8.16.39:
Browse files Browse the repository at this point in the history
        * Fix bug in ~^: parameter equal to NIL should mean
          "unsupplied" (found by PFD's test suite).
  • Loading branch information
Alexey Dejneka committed Nov 15, 2004
1 parent e9bb09d commit a5dc461
Show file tree
Hide file tree
Showing 5 changed files with 30 additions and 23 deletions.
2 changes: 2 additions & 0 deletions NEWS
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
21 changes: 9 additions & 12 deletions src/code/late-format.lisp
Original file line number Diff line number Diff line change
Expand Up @@ -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))))
Expand Down
17 changes: 7 additions & 10 deletions src/code/target-format.lisp
Original file line number Diff line number Diff line change
Expand Up @@ -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)))

Expand Down
11 changes: 11 additions & 0 deletions tests/print.impure.lisp
Original file line number Diff line number Diff line change
Expand Up @@ -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)
2 changes: 1 addition & 1 deletion version.lisp-expr
Original file line number Diff line number Diff line change
Expand Up @@ -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"

0 comments on commit a5dc461

Please sign in to comment.