diff --git a/pcl/fsc.lisp b/pcl/fsc.lisp index 6d7f28a5cd1391376f55ddb761ce769a75abd6eb..d0071f598508ff71c5864a7db7f09cca89deae2e 100644 --- a/pcl/fsc.lisp +++ b/pcl/fsc.lisp @@ -53,11 +53,11 @@ ;;; ;;; -(defmethod validate-superclass - ((fsc funcallable-standard-class) - (class standard-class)) - t) ; was (null (wrapper-instance-slots-layout (class-wrapper class))) - +(defmethod validate-superclass ((fsc funcallable-standard-class) + (new-super std-class)) + (let ((new-super-meta-class (class-of new-super))) + (or (eq new-super-meta-class *the-class-std-class*) + (eq (class-of fsc) new-super-meta-class)))) (defmethod allocate-instance ((class funcallable-standard-class) &rest initargs) diff --git a/pcl/std-class.lisp b/pcl/std-class.lisp index 3eb085abee0a0f99bd7cd395f15ec682af7a5b94..c3cec2f87e428502b606ca03b50e6819d517fda5 100644 --- a/pcl/std-class.lisp +++ b/pcl/std-class.lisp @@ -1017,6 +1017,10 @@ (or (eq new-super *the-class-t*) (eq (class-of class) (class-of new-super)))) +(defmethod validate-superclass ((class standard-class) (new-super std-class)) + (let ((new-super-meta-class (class-of new-super))) + (or (eq new-super-meta-class *the-class-std-class*) + (eq (class-of class) new-super-meta-class)))) ;;; @@ -1301,7 +1305,7 @@ ;;; (defmethod validate-superclass ((c slot-class) - (f forward-referenced-class)) + (f forward-referenced-class)) 't)