0.8.4.29:

[sbcl.git] / src / pcl / std-class.lisp

diff --git a/src/pcl/std-class.lisp b/src/pcl/std-class.lisp
index b2d4cb7..7b64b5a 100644 (file)
--- a/src/pcl/std-class.lisp
+++ b/src/pcl/std-class.lisp
@@ -118,50 +118,6 @@
 (defmethod slot-definition-allocation ((slotd structure-slot-definition))
   :instance)
 \f
-(defmethod shared-initialize :after ((object documentation-mixin)
-                                    slot-names
-                                    &key (documentation nil documentation-p))
-  (declare (ignore slot-names))
-  (when documentation-p
-    (setf (plist-value object 'documentation) documentation)))
-
-;;; default if DOC-TYPE doesn't match one of the specified types
-(defmethod documentation (object doc-type)
-  (warn "unsupported DOCUMENTATION: type ~S for object ~S"
-       doc-type
-       (type-of object))
-  nil)
-
-;;; default if DOC-TYPE doesn't match one of the specified types
-(defmethod (setf documentation) (new-value object doc-type)
-  ;; CMU CL made this an error, but since ANSI says that even for supported
-  ;; doc types an implementation is permitted to discard docs at any time
-  ;; for any reason, this feels to me more like a warning. -- WHN 19991214
-  (warn "discarding unsupported DOCUMENTATION of type ~S for object ~S"
-       doc-type
-       (type-of object))
-  new-value)
-
-(defmethod documentation ((object documentation-mixin) doc-type)
-  (declare (ignore doc-type))
-  (plist-value object 'documentation))
-
-(defmethod (setf documentation) (new-value
-                                (object documentation-mixin)
-                                doc-type)
-  (declare (ignore doc-type))
-  (setf (plist-value object 'documentation) new-value))
-
-(defmethod documentation ((slotd standard-slot-definition) doc-type)
-  (declare (ignore doc-type))
-  (slot-value slotd 'documentation))
-
-(defmethod (setf documentation) (new-value
-                                (slotd standard-slot-definition)
-                                doc-type)
-  (declare (ignore doc-type))
-  (setf (slot-value slotd 'documentation) new-value))
-\f
 ;;;; various class accessors that are a little more complicated than can be
 ;;;; done with automatically generated reader methods
 
@@ -336,8 +292,14 @@
 
 (setf (gdefinition 'load-defclass) #'real-load-defclass)
 
-(defun ensure-class (name &rest all)
-  (apply #'ensure-class-using-class (find-class name nil) name all))
+(defun ensure-class (name &rest args)
+  (apply #'ensure-class-using-class
+        (let ((class (find-class name nil)))
+          (when (and class (eq name (class-name class)))
+            ;; NAME is the proper name of CLASS, so redefine it
+            class))
+        name
+        args))
 
 (defmethod ensure-class-using-class ((class null) name &rest args &key)
   (multiple-value-bind (meta initargs)
@@ -655,7 +617,7 @@
              ;; FIXME: FIND-SLOT-DEFAULT throws an error if the slot
              ;; is unbound; maybe it should be a CELL-ERROR of some
              ;; sort?
-             (error () (slot-unbound class x slot-name)))))
+             (error () (values (slot-unbound class x slot-name))))))
     (setf (slot-definition-writer-function slotd)
          (lambda (v x)
            (condition-writer-function x v slot-name)))
@@ -989,7 +951,8 @@
              wrapper nwrapper))
       (setf (slot-value class 'finalized-p) t)
       (unless (eq owrapper nwrapper)
-       (update-pv-table-cache-info class)))))
+       (update-pv-table-cache-info class)
+       (maybe-update-standard-class-locations class)))))
 
 (defun compute-class-slots (eslotds)
   (let (collect)