r10922: 03 May 2006 Kevin Rosenberg <kevin@rosenberg.net>

[clsql.git] / sql / metaclasses.lisp

diff --git a/sql/metaclasses.lisp b/sql/metaclasses.lisp
index 701181da53a8bb3a4da0217511485eb1587ccb19..f3a377eadcc841d32c7a21a86792b8506e90feec 100644 (file)
--- a/sql/metaclasses.lisp
+++ b/sql/metaclasses.lisp
@@ -107,12 +107,12 @@
                                         qualifier
                                        &allow-other-keys)
   (let ((root-class (find-class 'standard-db-object nil))
-       (vmc (find-class 'standard-db-class)))
+       (vmc 'standard-db-class))
     (setf (view-class-qualifier class)
           (car qualifier))
     (if root-class
-       (if (member-if #'(lambda (super)
-                          (eq (class-of super) vmc)) direct-superclasses)
+       (if (some #'(lambda (super) (typep super vmc))
+                  direct-superclasses)
            (call-next-method)
             (apply #'call-next-method
                    class
@@ -135,7 +135,7 @@
                                           direct-superclasses qualifier
                                           &allow-other-keys)
   (let ((root-class (find-class 'standard-db-object nil))
-       (vmc (find-class 'standard-db-class)))
+       (vmc 'standard-db-class))
     (setf (view-table class)
           (table-name-from-arg (sql-escape (or (and base-table
                                                     (if (listp base-table)
@@ -145,8 +145,8 @@
     (setf (view-class-qualifier class)
           (car qualifier))
     (if (and root-class (not (equal class root-class)))
-       (if (member-if #'(lambda (super)
-                          (eq (class-of super) vmc)) direct-superclasses)
+       (if (some #'(lambda (super) (typep super vmc))
+                  direct-superclasses)
            (call-next-method)
             (apply #'call-next-method
                    class
@@ -444,8 +444,8 @@ which does type checking before storing a value in a slot."
               (null (specified-type dsd)))
       (setf (specified-type dsd)
        (slot-definition-type dsd))
-      (setf #-clisp (slot-value dsd 'type)
-           #+clisp (slot-definition-type dsd)
+      (setf #-(or clisp sbcl) (slot-value dsd 'type)
+           #+(or clisp sbcl) (slot-definition-type dsd)
            (compute-lisp-type-from-slot-specification
             dsd (slot-definition-type dsd))))