-6 May 2004 Kevin Rosenberg (kevin@rosenberg.net)
+7 May 2004 Kevin Rosenberg (kevin@rosenberg.net)
+ * sql/metaclass.lisp: Work-around openmcl's CHANGE-CLASS
+ changing the type-specifier. Use a lisp type of (OR NULL FOO)
+ for a specified-type of FOO unless :db-constraints :not-null.
* tests/test-*.lisp: Rename fields so that joins occur on
fields with different names. This ensures that join code is
selecting the proper name.
view class for testing.
* sql/objects.lisp: Use view-table rather than name of table
in a number of places to fix errors noted with using :base-table.
-
+
6 May 2004 Marcus Pearce (m.t.pearce@city.ac.uk)
* sql/objects.lisp: replace *update-records-on-make-instance* with
*db-auto-sync* which also controls both automatic creation of
(defun compute-lisp-type-from-slot-specification (slotd specified-type)
"Computes the Lisp type for a user-specified type. Needed for OpenMCL
which does type checking before storing a value in a slot."
- (declare (ignore slotd))
;; This function is called after the base compute-effective-slots is called.
;; OpenMCL sets the type-predicate based on the initial value of the slots type.
;; so we have to override the type-predicates here
specified-type)))
((eq (ensure-keyword specified-type) :bigint)
'integer)
- #+openmcl
- ((null specified-type)
- t)
+ ((and specified-type
+ (not (eql :not-null (slot-value slotd 'db-constraints))))
+ `(or null ,specified-type))
(t
specified-type)))
)
;; all other slots
(t
- (change-class esd 'view-class-effective-slot-definition
- #+allegro :name
- #+allegro (slot-definition-name dsd))
+ (let ((type-predicate #+openmcl (slot-value esd 'ccl::type-predicate)))
+
+ (change-class esd 'view-class-effective-slot-definition
+ #+allegro :name
+ #+allegro (slot-definition-name dsd))
+ #+openmcl (setf (slot-value esd 'ccl::type-predicate)
+ type-predicate))
(setf (slot-value esd 'column)
(column-name-from-arg
(sql-escape (slot-definition-name dsd))))
-
+
(setf (slot-value esd 'db-info) nil)
- (setf (slot-value esd 'db-kind)
- :virtual)))
+ (setf (slot-value esd 'db-kind) :virtual)
+ (setf (specified-type esd) (slot-definition-type dsd)))
+ )
esd)))
(defun slotdefs-for-slots-with-class (slots class)