r8847: rename clsql to clsql-classic

[clsql.git] / usql / metaclasses.lisp

diff --git a/usql/metaclasses.lisp b/usql/metaclasses.lisp
index 6332d9ea528b9d9c12b53396e00484191382d153..60679fb409eb08d062beb0ccb8acc5ac1520af5d 100644 (file)
--- 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))))