projects
/
clsql.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
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))
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
(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
(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))
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)
(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)))
(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
(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))
(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))))
(compute-lisp-type-from-slot-specification
dsd (slot-definition-type dsd))))