From 57eae6573811f44abe167a9015116d95371543bb Mon Sep 17 00:00:00 2001 From: Christophe Rhodes Date: Mon, 19 Jul 2010 06:30:07 +0000 Subject: [PATCH] 1.0.40.2: ctor machinery bugfixes One bug was a simple harmless thinko, limiting the cache for validity checking of reinitialize-instance initargs to only one list of keys. The other is actually a correctness problem: addition or removal of methods on MAKE-INSTANCE and ALLOCATE-INSTANCE would invalidate the wrong set of initarg validity caches and reset the wrong ctors. I think at the moment this bug is tricky to trigger, because those methods have no effect on reinitialize-instance initarg checking, and fallback ctors on non-standard metaclasses are very conservative in their assumptions. --- src/pcl/ctor.lisp | 18 +++++++++++++----- version.lisp-expr | 2 +- 2 files changed, 14 insertions(+), 6 deletions(-) diff --git a/src/pcl/ctor.lisp b/src/pcl/ctor.lisp index 6584142..9bcfbd8 100644 --- a/src/pcl/ctor.lisp +++ b/src/pcl/ctor.lisp @@ -932,8 +932,16 @@ (flet ((class-of-1st-method-param (method) (type-class (first (method-specializers method))))) (case (generic-function-name generic-function) - ((make-instance allocate-instance - initialize-instance shared-initialize) + ((make-instance allocate-instance) + ;; FIXME: I can't see a way of working out which classes a + ;; given metaclass specializer are applicable to short of + ;; iterating and testing with class-of. It would be good + ;; to not invalidate caches of system classes at this + ;; point (where it is not legal to define a method + ;; applicable to them on system functions). -- CSR, + ;; 2010-07-13 + (reset (find-class 'standard-object) t t)) + ((initialize-instance shared-initialize) (reset (class-of-1st-method-param method) t t)) ((reinitialize-instance) (reset (class-of-1st-method-param method) t nil)) @@ -956,8 +964,8 @@ (defun check-ri-initargs (instance initargs) (let* ((class (class-of instance)) (keys (plist-keys initargs)) - (cached (assoc keys (plist-value class 'ri-initargs) - :test #'equal)) + (cache (plist-value class 'ri-initargs)) + (cached (assoc keys cache :test #'equal)) (invalid-keys (if (consp cached) (cdr cached) @@ -971,7 +979,7 @@ (list* 'shared-initialize instance nil initargs)) t nil))) (setf (plist-value class 'ri-initargs) - (acons keys invalid cached)) + (acons keys invalid cache)) invalid)))) (when invalid-keys (error 'initarg-error :class class :initargs invalid-keys)))) diff --git a/version.lisp-expr b/version.lisp-expr index 6c9b510..ef0661d 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".) -"1.0.40.1" +"1.0.40.2" -- 1.7.10.4