From af141fe8d840aeb9011e3c6d2d6492216a12304c Mon Sep 17 00:00:00 2001 From: Alexey Dejneka Date: Sun, 19 Dec 2004 09:59:18 +0000 Subject: [PATCH] 0.8.17.30: * Merged patch for the bug 348 by Gabor Melis. --- BUGS | 13 ------------- NEWS | 2 ++ src/code/defstruct.lisp | 12 +++++++----- tests/defstruct.impure.lisp | 11 +++++++++++ version.lisp-expr | 2 +- 5 files changed, 21 insertions(+), 19 deletions(-) diff --git a/BUGS b/BUGS index 95bad80..010c3b7 100644 --- a/BUGS +++ b/BUGS @@ -1538,19 +1538,6 @@ WORKAROUND: In sbcl-0.8.13, all backtraces from errors caused by internal errors on the alpha seem to have a "bogus stack frame". -348: - Structure slot setters do not preserve evaluation order: - - (defstruct foo (x)) - - (let ((i (eval '-2)) - (x (make-foo))) - (funcall #'(setf foo-x) - (incf i) - (aref (vector x) (incf i))) - (foo-x x)) - => error - 349: PPRINT-INDENT rounding implementation decisions At present, pprint-indent (and indeed the whole pretty printer) more-or-less assumes that it's using a monospace font. That's diff --git a/NEWS b/NEWS index 4e93d5a..d956277 100644 --- a/NEWS +++ b/NEWS @@ -31,6 +31,8 @@ changes in sbcl-0.8.18 relative to sbcl-0.8.17: argument, which must always be NIL. (reported by Kalle Niemitalo) * bug fix: printing 1.0d+23 no longer results in an error. (reported by Rolf Wester for CMUCL; bug fix from Raymond Toy) + * bug fix: structure slot setters preserve evaluation order. (thanks + to Gabor Melis) * fixed some bugs related to Unicode integration: ** RUN-PROGRAM can allow its child to take input from a Lisp stream. (reported by Stefan Scholl) diff --git a/src/code/defstruct.lisp b/src/code/defstruct.lisp index 182e978..8a72c68 100644 --- a/src/code/defstruct.lisp +++ b/src/code/defstruct.lisp @@ -931,11 +931,13 @@ `(,value-the ,dsd-type ,(subst instance 'instance accessor-place-form))) (sb!c:source-transform-lambda (new-value instance) - (destructuring-bind (accessor-name &rest accessor-args) - accessor-place-form - `(,(info :setf :inverse accessor-name) - ,@(subst instance 'instance accessor-args) - (the ,dsd-type ,new-value))))))) + (destructuring-bind (accessor-name &rest accessor-args) + accessor-place-form + (once-only ((new-value new-value) + (instance instance)) + `(,(info :setf :inverse accessor-name) + ,@(subst instance 'instance accessor-args) + (the ,dsd-type ,new-value)))))))) ;;; Return a LAMBDA form which can be used to set a slot. (defun slot-setter-lambda-form (dd dsd) diff --git a/tests/defstruct.impure.lisp b/tests/defstruct.impure.lisp index 5f9aa1d..f1b06b5 100644 --- a/tests/defstruct.impure.lisp +++ b/tests/defstruct.impure.lisp @@ -562,6 +562,17 @@ (setf (find-class 'foo) nil) (defstruct foo slot-1))))) +;;; bug 348, evaluation order of slot writer arguments. Fixed by Gabor +;;; Melis. +(defstruct bug-348 x) + +(assert (eql -1 (let ((i (eval '-2)) + (x (make-bug-348))) + (funcall #'(setf bug-348-x) + (incf i) + (aref (vector x) (incf i))) + (bug-348-x x)))) + ;;; success (format t "~&/returning success~%") (quit :unix-status 104) diff --git a/version.lisp-expr b/version.lisp-expr index a880985..bb83dce 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.17.29" +"0.8.17.30" -- 1.7.10.4