0.pre8.13:
authorChristophe Rhodes <csr21@cam.ac.uk>
Sat, 29 Mar 2003 15:14:28 +0000 (15:14 +0000)
committerChristophe Rhodes <csr21@cam.ac.uk>
Sat, 29 Mar 2003 15:14:28 +0000 (15:14 +0000)
Make ENSURE-CLASS-USING-CLASS's arguments go the AMOP-specified
way round (noted sbcl-devel 2003-29-03 by CSR)

NEWS
src/pcl/braid.lisp
src/pcl/generic-functions.lisp
src/pcl/std-class.lisp
tests/mop.impure.lisp
version.lisp-expr

diff --git a/NEWS b/NEWS
index c7ff1eb..34505a7 100644 (file)
--- a/NEWS
+++ b/NEWS
@@ -1629,8 +1629,10 @@ changes in sbcl-0.8.0 relative to sbcl-0.7.14
   * 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;
index b256c00..0fc49bb 100644 (file)
                (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)
index 8734818..4e2eb2c 100644 (file)
 
 (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))
 
index 043e0da..558d920 100644 (file)
 (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))
index 22cbcb1..e446bff 100644 (file)
                                  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)
index ad7d954..89090f7 100644 (file)
@@ -18,4 +18,4 @@
 ;;; 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"