projects
/
clsql.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
r10048: support clisp's attribute name for the type field in class direct slots
[clsql.git]
/
sql
/
metaclasses.lisp
diff --git
a/sql/metaclasses.lisp
b/sql/metaclasses.lisp
index bb02da3899c849151288056ac2080f06ea0532d4..a086288198f03161cfe8ca33cfd0f2a38f1e0054 100644
(file)
--- a/
sql/metaclasses.lisp
+++ b/
sql/metaclasses.lisp
@@
-165,11
+165,13
@@
(nth (1+ pos) list)))))
(mapcar #'extract keys)))
(nth (1+ pos) list)))))
(mapcar #'extract keys)))
+(defvar *impl-type-attrib-name* #-clisp 'type #+clisp 'clos::$type)
+
(defun describe-db-layout (class)
(flet ((not-db-col (col)
(not (member (nth 2 col) '(nil :base :key))))
(frob-slot (slot)
(defun describe-db-layout (class)
(flet ((not-db-col (col)
(not (member (nth 2 col) '(nil :base :key))))
(frob-slot (slot)
- (let ((type (slot-value slot
'type
)))
+ (let ((type (slot-value slot
*impl-type-attrib-name*
)))
(if (eq type t)
(setq type nil))
(list (slot-value slot 'name)
(if (eq type t)
(setq type nil))
(list (slot-value slot 'name)
@@
-442,7
+444,7
@@
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 (slot-value dsd
'type
)
+ (setf (slot-value dsd
*impl-type-attrib-name*
)
(compute-lisp-type-from-slot-specification
dsd (slot-definition-type dsd))))
(compute-lisp-type-from-slot-specification
dsd (slot-definition-type dsd))))