X-Git-Url: http://git.kpe.io/?p=clsql.git;a=blobdiff_plain;f=sql%2Fmetaclasses.lisp;h=5d254bfa5e33ad71f2f6cd80fe2ec434ee3f3b4d;hp=701181da53a8bb3a4da0217511485eb1587ccb19;hb=656074cf47344a3cedaf1986fc7677f573fd5c6f;hpb=0817beb5857835cfe68867e7026161f356869bdf diff --git a/sql/metaclasses.lisp b/sql/metaclasses.lisp index 701181d..5d254bf 100644 --- 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