* fixed a bug in computing method discriminating functions: it is
now possible to define methods specialized on classes which have
forward-referenced superclasses. (thanks to Gerd Moellmann)
- * fixed evaluation order in optional entries. (reported by Gilbert
+ * fixed evaluation order in optional entries. (reported by Gilbert
Baumann)
+ * SB-MOP:ENSURE-CLASS-USING-CLASS now takes its arguments in the
+ specified-by-AMOP order of (CLASS NAME &REST ARGS &KEY).
* fixed some bugs revealed by Paul Dietz' test suite:
** COPY-ALIST now signals an error if its argument is a dotted
list;
(mapcar #'classoid-name (classoid-direct-superclasses
(find-classoid name)))))
(if slotsp
- (ensure-class-using-class name nil
+ (ensure-class-using-class nil name
:metaclass metaclass :name name
:direct-superclasses supers
:direct-slots slots)
- (ensure-class-using-class name nil
+ (ensure-class-using-class nil name
:metaclass metaclass :name name
:direct-superclasses supers)))))
(cond ((structure-type-p name)
(defgeneric allocate-instance (class &rest initargs))
-(defgeneric ensure-class-using-class (name
- class
+(defgeneric ensure-class-using-class (class
+ name
&rest args
&key &allow-other-keys))
(setf (gdefinition 'load-defclass) #'real-load-defclass)
(defun ensure-class (name &rest all)
- (apply #'ensure-class-using-class name (find-class name nil) all))
+ (apply #'ensure-class-using-class (find-class name nil) name all))
-(defmethod ensure-class-using-class (name (class null) &rest args &key)
+(defmethod ensure-class-using-class ((class null) name &rest args &key)
(multiple-value-bind (meta initargs)
(ensure-class-values class args)
(set-class-type-translation (class-prototype meta) name)
(set-class-type-translation class name)
class))
-(defmethod ensure-class-using-class (name (class pcl-class) &rest args &key)
+(defmethod ensure-class-using-class ((class pcl-class) name &rest args &key)
(multiple-value-bind (meta initargs)
(ensure-class-values class args)
(unless (eq (class-of class) meta) (change-class class meta))
0))
collect x)))
\f
+;;; make sure that ENSURE-CLASS-USING-CLASS's arguments are the right
+;;; way round (!)
+(defvar *e-c-u-c-arg-order* nil)
+(defmethod ensure-class-using-class :after
+ (class (name (eql 'e-c-u-c-arg-order)) &key &allow-other-keys)
+ (setf *e-c-u-c-arg-order* t))
+(defclass e-c-u-c-arg-orderoid () ())
+(assert (null *e-c-u-c-arg-order*))
+(defclass e-c-u-c-arg-order () ())
+(assert (eq *e-c-u-c-arg-order* t))
;;;; success
(sb-ext:quit :unix-status 104)
;;; versions, especially for internal versions off the main CVS
;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"0.pre8.12"
+"0.pre8.13"