From 1422f9e5fa1d80247d809440112eb00075440a81 Mon Sep 17 00:00:00 2001 From: William Harold Newman Date: Sun, 8 Feb 2004 19:37:53 +0000 Subject: [PATCH] 0.8.7.47: fixed bug: FORMAT ~W interpreter dependence on ATSIGNP --- src/code/target-format.lisp | 4 ++-- tests/print.impure.lisp | 35 +++++++++++++++++++++++++++++++++++ version.lisp-expr | 2 +- 3 files changed, 38 insertions(+), 3 deletions(-) diff --git a/src/code/target-format.lisp b/src/code/target-format.lisp index bc90907..99cbb3f 100644 --- a/src/code/target-format.lisp +++ b/src/code/target-format.lisp @@ -235,8 +235,8 @@ (def-format-interpreter #\W (colonp atsignp params) (interpret-bind-defaults () params (let ((*print-pretty* (or colonp *print-pretty*)) - (*print-level* (and atsignp *print-level*)) - (*print-length* (and atsignp *print-length*))) + (*print-level* (unless atsignp *print-level*)) + (*print-length* (unless atsignp *print-length*))) (output-object (next-arg) stream)))) ;;;; format interpreters and support functions for integer output diff --git a/tests/print.impure.lisp b/tests/print.impure.lisp index 69ff13c..8de1bc5 100644 --- a/tests/print.impure.lisp +++ b/tests/print.impure.lisp @@ -134,5 +134,40 @@ ;;; violations through stack corruption. (print 0.0001) +;;; In sbcl-0.8.7, the ~W format directive interpreter implemented the +;;; sense of the colon and at-sign modifiers exactly backwards. +;;; +;;; (Yes, the test for this *is* substantially hairier than the fix; +;;; wanna make something of it?) +(cl:in-package :cl-user) +(defstruct wexerciser-0-8-7) +(defun wexercise-0-8-7-interpreted (wformat) + (format t wformat (make-wexerciser-0-8-7))) +(defmacro define-compiled-wexercise-0-8-7 (wexercise wformat) + `(defun ,wexercise () + (declare (optimize (speed 3) (space 1))) + (format t ,wformat (make-wexerciser-0-8-7)) + (values))) +(define-compiled-wexercise-0-8-7 wexercise-0-8-7-compiled-without-atsign "~W") +(define-compiled-wexercise-0-8-7 wexercise-0-8-7-compiled-with-atsign "~@W") +(defmethod print-object :before ((wexerciser-0-8-7 wexerciser-0-8-7) stream) + (unless (and *print-level* *print-length*) + (error "gotcha coming"))) +(let ((*print-level* 11) + (*print-length* 12)) + (wexercise-0-8-7-interpreted "~W") + (wexercise-0-8-7-compiled-without-atsign)) +(remove-method #'print-object + (find-method #'print-object + '(:before) + (mapcar #'find-class '(wexerciser-0-8-7 t)))) +(defmethod print-object :before ((wexerciser-0-8-7 wexerciser-0-8-7) stream) + (when (or *print-level* *print-length*) + (error "gotcha going"))) +(let ((*print-level* 11) + (*print-length* 12)) + (wexercise-0-8-7-interpreted "~@W") + (wexercise-0-8-7-compiled-with-atsign)) + ;;; success (quit :unix-status 104) diff --git a/version.lisp-expr b/version.lisp-expr index 01b9d72..a0d7411 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.7.46" +"0.8.7.47" -- 1.7.10.4