From add57c72c932fbf70c8ba8297154936c908b410e Mon Sep 17 00:00:00 2001 From: Nikodemus Siivola Date: Mon, 17 May 2004 21:15:04 +0000 Subject: [PATCH] 0.8.10.32: Fixed ansi-test DEFCLASS-0211.1 (broken in compiled code only): ... SB-PCL::COMPUTE-SLOTS :AROUND now checks if initfuntions exist for unbound slots, and uses them to initialize. Similar task used to be done by the bygone SB-PCL::UPDATE-SHARED-SLOT-VALUES. This is hopefully more correct. ... Renamed SB-PCL::UPDATE-INITS to SB-PCL::UPDATE-INITARGS for clarity. ... Test case added. --- NEWS | 2 ++ src/pcl/std-class.lisp | 12 +++++++++--- tests/clos.impure-cload.lisp | 10 ++++++++++ version.lisp-expr | 2 +- 4 files changed, 22 insertions(+), 4 deletions(-) diff --git a/NEWS b/NEWS index 870970d..29710b5 100644 --- a/NEWS +++ b/NEWS @@ -2445,6 +2445,8 @@ changes in sbcl-0.8.11 relative to sbcl-0.8.10: :LOAD-TOPLEVEL context; this appears to decrease fasl sizes by approximately 10%. * fixed some bugs revealed by Paul Dietz' test suite: + ** Fixed an optimization bug related to inheritance of initforms + from local to shared slots. ** FILE-POSITION works as specified on BROADCAST-STREAMs. ** CAST optimizer forgot to flush argument derived type. ** print/read consistency on floats is now orders of magnitude diff --git a/src/pcl/std-class.lisp b/src/pcl/std-class.lisp index 2e2464f..a6cec9d 100644 --- a/src/pcl/std-class.lisp +++ b/src/pcl/std-class.lisp @@ -869,7 +869,7 @@ ;; (section 5.5.2 of AMOP). (update-slots class (compute-slots class)) (update-gfs-of-class class) - (update-inits class (compute-default-initargs class)) + (update-initargs class (compute-default-initargs class)) (update-ctors 'finalize-inheritance :class class)) (unless finalizep (dolist (sub (class-direct-subclasses class)) (update-class sub nil)))) @@ -975,7 +975,7 @@ (update-gf-dfun class gf)) gf-table))))) -(defun update-inits (class inits) +(defun update-initargs (class inits) (setf (plist-value class 'default-initargs) inits)) (defmethod compute-default-initargs ((class slot-class)) @@ -1030,7 +1030,13 @@ (from-class (slot-definition-allocation-class eslotd)) (cell (assq name (class-slot-cells from-class)))) (aver (consp cell)) - cell)))) + (if (eq +slot-unbound+ (cdr cell)) + ;; We may have inherited an initfunction + (let ((initfun (slot-definition-initfunction eslotd))) + (if initfun + (rplacd cell (funcall initfun)) + cell)) + cell))))) (initialize-internal-slot-functions eslotd)))) (defmethod compute-slots ((class funcallable-standard-class)) diff --git a/tests/clos.impure-cload.lisp b/tests/clos.impure-cload.lisp index d866200..67032c5 100644 --- a/tests/clos.impure-cload.lisp +++ b/tests/clos.impure-cload.lisp @@ -94,6 +94,16 @@ (assert (= (slot-value (make-instance 'definitargs-class) 'a) 1)) (assert (= (slot-value (make-instance 'definitargs-class :a 0) 'a) 0)) (assert (= *definitargs-counter* 2)) + +;;; inherited local -> shared slot initforms +;; (adapted from Paul F. Dietz's test suite DEFCLASS-0211.1) +(defclass shared-to-local-initform-super () + ((redefined :allocation :instance :initform 'orig-initform))) +(defclass shared-to-local-initform-sub (shared-to-local-initform-super) + ((redefined :allocation :class))) +(assert (slot-boundp (make-instance 'shared-to-local-initform-sub) 'redefined)) +(assert (eq 'orig-initform + (slot-value (make-instance 'shared-to-local-initform-sub) 'redefined))) ;;; success (sb-ext:quit :unix-status 104) \ No newline at end of file diff --git a/version.lisp-expr b/version.lisp-expr index 676fef9..3b39ef3 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.10.31" +"0.8.10.32" -- 1.7.10.4