X-Git-Url: http://git.kpe.io/?a=blobdiff_plain;f=usql%2Fmetaclasses.lisp;h=60679fb409eb08d062beb0ccb8acc5ac1520af5d;hb=39d3fefaebf35a19a211d1ab6552d7ff54faccd2;hp=6332d9ea528b9d9c12b53396e00484191382d153;hpb=3da1a0ba2b4ded66dca0bec9c4e23457eb7ff079;p=clsql.git

diff --git a/usql/metaclasses.lisp b/usql/metaclasses.lisp
index 6332d9e..60679fb 100644
--- a/usql/metaclasses.lisp
+++ b/usql/metaclasses.lisp
@@ -145,7 +145,6 @@ of the default method.  The extra allowed options are the value of the
     result))
 
 
-#+(or cmu scl sbcl openmcl)
 (defmethod validate-superclass ((class standard-db-class)
 				(superclass standard-class))
   t)
@@ -277,13 +276,14 @@ of the default method.  The extra allowed options are the value of the
     (let ((all-slots (mapcar #'frob-slot slots)))
       (setq all-slots (remove-if #'not-db-col all-slots))
       (setq all-slots (stable-sort all-slots #'string< :key #'car))
-      (setf (object-definition class) all-slots
-	    (key-slots class) (remove-if-not (lambda (slot)
-					       (eql (slot-value slot 'db-kind)
-						    :key))
-					     (class-slots class))))))
-
-#+allegro
+      (setf (object-definition class) all-slots))
+    #-(or allegro openmcl)
+    (setf (key-slots class) (remove-if-not (lambda (slot)
+					     (eql (slot-value slot 'db-kind)
+						  :key))
+					   (class-slots class)))))
+
+#+(or allegro openmcl)
 (defmethod finalize-inheritance :after ((class standard-db-class))
   (setf (key-slots class) (remove-if-not (lambda (slot)
 					   (eql (slot-value slot 'db-kind)
@@ -494,7 +494,9 @@ all NULL values retrieved are converted by DATABASE-NULL-VALUE")
                    (view-class-slot-db-info sd)))))
       ;; all other slots
       (t
-       (change-class slotd 'view-class-effective-slot-definition)
+       (change-class slotd 'view-class-effective-slot-definition
+		     #+allegro :name 
+		     #+allegro (slot-definition-name sd))
        (setf (slot-value slotd 'column)
              (column-name-from-arg
               (sql-escape (slot-definition-name sd))))