[Bug-openmcl] initarg caching

[Gary Byers]

This has been there since May of last year; it actually got fixed a few
days ago in the development sources.

It's fixed in the main CVS tree now.


On Tue, 9 Mar 2004, James Bielman wrote:

> Hi,
>
> The following code reliably reproduces an error for me in both OpenMCL
> 0.14.1-p1 and 0.14-031220:
>
> ;;; initarg-caching.lisp --- Reproduce initarg caching errors.
>
> (defclass foo ()
>   ((bar :initarg :bar)))
>
> ;; Change the #+ to #- to disable this form and the problem goes away.
> #+(and)
> (format t "~&;Before redefinition: ~A~%" (make-instance 'foo :bar t))
>
> (defclass foo ()
>   ((bar :initarg :bar)
>    (baz :initarg :baz)))
>
> (format t "~&;After redefinition: ~A~%" (make-instance 'foo :bar t :baz t))
>
> ;;; results in:
>
> > Error in process listener(3): :BAZ is an invalid initarg to INITIALIZE-INSTANCE for #<STANDARD-CLASS FOO>.
> >                               Valid initargs: #(:BAR).
> > While executing: CCL::CHECK-INITARGS
> > Type :POP to abort.
> Type :? for other options.
>
> James
> _______________________________________________
> Bug-openmcl mailing list
> Bug-openmcl at clozure.com
> http://clozure.com/mailman/listinfo/bug-openmcl
>
>
-------------- next part --------------
Index: l1-clos.lisp
===================================================================
RCS file: /usr/local/tmpcvs/ccl-0.14/ccl/level-1/l1-clos.lisp,v
retrieving revision 1.6
diff -u -r1.6 l1-clos.lisp
--- l1-clos.lisp	10 Feb 2004 21:56:31 -0000	1.6
+++ l1-clos.lisp	9 Mar 2004 23:51:33 -0000
@@ -482,9 +482,16 @@
         (sort-list slotds '< #'slotd-position)))))
 
 (defun class-has-a-forward-referenced-superclass-p (class)
-  (or (forward-referenced-class-p class)
-      (some #'class-has-a-forward-referenced-superclass-p
-	    (%class-direct-superclasses class))))
+  (or (if (forward-referenced-class-p class) class)
+      (dolist (s (%class-direct-superclasses class))
+	(let* ((fwdref (class-has-a-forward-referenced-superclass-p s)))
+	  (when fwdref (return fwdref))))))
+
+(defmethod compute-class-precedence-list ((class class))
+  (let* ((fwdref (class-has-a-forward-referenced-superclass-p class)))
+    (when fwdref
+      (error "~&Class ~s can't be finalized because at least one of its superclasses (~s) is a FORWARD-REFERENCED-CLASS." class fwdref)))
+  (compute-cpl class))
 
 (defun update-cpl (class cpl)
   (if (class-finalized-p class)
@@ -494,6 +501,19 @@
     (setf (%class.cpl class) cpl)))
 
 
+;;; Classes that can't be instantiated via MAKE-INSTANCE have no
+;;; initargs caches.
+(defmethod %flush-initargs-caches ((class class))
+  )
+
+;;; Classes that have initargs caches should flush them when the
+;;; class is finalized.
+(defmethod %flush-initargs-caches ((class std-class))
+  (setf (%class.make-instance-initargs class) nil
+	(%class.reinit-initargs class) nil
+	(%class.redefined-initargs class) nil
+	(%class.changed-initargs class) nil))
+
 
 (defun update-class (class finalizep)
   ;;
@@ -511,10 +531,11 @@
   (when (or finalizep
 	    (class-finalized-p class)
 	    (not (class-has-a-forward-referenced-superclass-p class)))
-    (update-cpl class (compute-cpl  class))
+    (update-cpl class (compute-class-precedence-list  class))
     ;;; This -should- be made to work for structure classes
     (update-slots class (compute-slots class))
     (setf (%class-default-initargs class) (compute-default-initargs class))
+    (%flush-initargs-caches class)
     )
   (unless finalizep
     (dolist (sub (%class-direct-subclasses class))