projects
/
clsql.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
r9485: 26 May 2004 Kevin Rosenberg <kevin@rosenberg.net>
[clsql.git]
/
sql
/
metaclasses.lisp
diff --git
a/sql/metaclasses.lisp
b/sql/metaclasses.lisp
index f981c900be363b18be8e67cd8db6895e800d465e..a43c4acd836381ab77f928401c542aa191717e02 100644
(file)
--- a/
sql/metaclasses.lisp
+++ b/
sql/metaclasses.lisp
@@
-12,7
+12,7
@@
;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL.
;;;; *************************************************************************
;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL.
;;;; *************************************************************************
-(in-package #:clsql)
+(in-package #:clsql
-sys
)
(eval-when (:compile-toplevel :load-toplevel :execute)
(when (>= (length (generic-function-lambda-list
(eval-when (:compile-toplevel :load-toplevel :execute)
(when (>= (length (generic-function-lambda-list
@@
-362,7
+362,7
@@
column definition in the database.")
(defun compute-class-precedence-list (class)
(class-precedence-list class))))
(defun compute-class-precedence-list (class)
(class-precedence-list class))))
-#-
(or sbcl cmu)
+#-
mop-slot-order-reversed
(defmethod compute-slots ((class standard-db-class))
"Need to sort order of class slots so they are the same across
implementations."
(defmethod compute-slots ((class standard-db-class))
"Need to sort order of class slots so they are the same across
implementations."
@@
-392,10
+392,20
@@
which does type checking before storing a value in a slot."
((and (symbolp (car specified-type))
(string-equal (symbol-name (car specified-type)) "string"))
'string)
((and (symbolp (car specified-type))
(string-equal (symbol-name (car specified-type)) "string"))
'string)
+ ((and (symbolp (car specified-type))
+ (string-equal (symbol-name (car specified-type)) "varchar"))
+ 'string)
+ ((and (symbolp (car specified-type))
+ (string-equal (symbol-name (car specified-type)) "char"))
+ 'string)
(t
specified-type)))
((eq (ensure-keyword specified-type) :bigint)
'integer)
(t
specified-type)))
((eq (ensure-keyword specified-type) :bigint)
'integer)
+ ((eq (ensure-keyword specified-type) :char)
+ 'character)
+ ((eq (ensure-keyword specified-type) :varchar)
+ 'string)
((and specified-type
(not (eql :not-null (slot-value slotd 'db-constraints))))
`(or null ,specified-type))
((and specified-type
(not (eql :not-null (slot-value slotd 'db-constraints))))
`(or null ,specified-type))
@@
-497,6
+507,7
@@
which does type checking before storing a value in a slot."
;; all other slots
(t
(let ((type-predicate #+openmcl (slot-value esd 'ccl::type-predicate)))
;; all other slots
(t
(let ((type-predicate #+openmcl (slot-value esd 'ccl::type-predicate)))
+ #-openmcl (declare (ignore type-predicate))
(change-class esd 'view-class-effective-slot-definition
#+allegro :name
#+allegro (slot-definition-name dsd))
(change-class esd 'view-class-effective-slot-definition
#+allegro :name
#+allegro (slot-definition-name dsd))