projects
/
sbcl.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
0.8.11.4:
[sbcl.git]
/
src
/
pcl
/
std-class.lisp
diff --git
a/src/pcl/std-class.lisp
b/src/pcl/std-class.lisp
index
2e2464f
..
ca020b4
100644
(file)
--- 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)
;; (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))))
(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)))))
(update-gf-dfun class gf))
gf-table)))))
-(defun update-inits (class inits)
+(defun update-initargs (class inits)
(setf (plist-value class 'default-initargs) inits))
\f
(defmethod compute-default-initargs ((class slot-class))
(setf (plist-value class 'default-initargs) inits))
\f
(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))
(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))
(initialize-internal-slot-functions eslotd))))
(defmethod compute-slots ((class funcallable-standard-class))
@@
-1322,7
+1328,9
@@
class)))
(defmethod make-instances-obsolete ((class symbol))
class)))
(defmethod make-instances-obsolete ((class symbol))
- (make-instances-obsolete (find-class class)))
+ (make-instances-obsolete (find-class class))
+ ;; ANSI wants the class name when called with a symbol.
+ class)
;;; OBSOLETE-INSTANCE-TRAP is the internal trap that is called when we
;;; see an obsolete instance. The times when it is called are:
;;; OBSOLETE-INSTANCE-TRAP is the internal trap that is called when we
;;; see an obsolete instance. The times when it is called are: