From: Christophe Rhodes <csr21@cam.ac.uk>
Date: Sat, 29 Mar 2003 15:14:28 +0000 (+0000)
Subject: 0.pre8.13:
X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=41d85303c73124856e193aea2c15f4e8f5bb9ec8;p=sbcl.git

0.pre8.13:
	Make ENSURE-CLASS-USING-CLASS's arguments go the AMOP-specified
	way round (noted sbcl-devel 2003-29-03 by CSR)
---

diff --git a/NEWS b/NEWS
index c7ff1eb..34505a7 100644
--- 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;
diff --git a/src/pcl/braid.lisp b/src/pcl/braid.lisp
index b256c00..0fc49bb 100644
--- a/src/pcl/braid.lisp
+++ b/src/pcl/braid.lisp
@@ -543,11 +543,11 @@
 		(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)
diff --git a/src/pcl/generic-functions.lisp b/src/pcl/generic-functions.lisp
index 8734818..4e2eb2c 100644
--- a/src/pcl/generic-functions.lisp
+++ b/src/pcl/generic-functions.lisp
@@ -476,8 +476,8 @@
 
 (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))
 
diff --git a/src/pcl/std-class.lisp b/src/pcl/std-class.lisp
index 043e0da..558d920 100644
--- a/src/pcl/std-class.lisp
+++ b/src/pcl/std-class.lisp
@@ -327,9 +327,9 @@
 (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)
@@ -338,7 +338,7 @@
     (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))
diff --git a/tests/mop.impure.lisp b/tests/mop.impure.lisp
index 22cbcb1..e446bff 100644
--- a/tests/mop.impure.lisp
+++ b/tests/mop.impure.lisp
@@ -124,5 +124,15 @@
 				  0))
 		    collect x)))
 
+;;; 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)
diff --git a/version.lisp-expr b/version.lisp-expr
index ad7d954..89090f7 100644
--- a/version.lisp-expr
+++ b/version.lisp-expr
@@ -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"