patch: view class slot types in openmcl

James Bielman <[email protected]> Sun, 07 May 2006 17:52:09 -0700

Newsgroups	gmane.lisp.clsql.devel
Message-ID	<[email protected]>

Hi,

Here's a patch that fixes an apparent bug in the computation of view
class slot types needed for OpenMCL.  It should always check the
slot's constraints for :NOT-NULL and add (OR NULL ...) to the type,
not only when the type is unknown.

For example, the following fails in 3.5.7 in OpenMCL:

(def-view-class user ()
  ((name :initform nil :initarg :name :type (varchar 64))))

(make-instance 'user)

with this error:

Error: The value NIL, derived from the initform NIL, can not be used
to set the value of the slot NAME in #<USER #x300004DB28BD>, because
it is not of type (VECTOR CHARACTER).

This patch also handles the case where the :NOT-NULL constraint is in
list form, such as with:

  :db-constraints (:not-null :unique)

James

_______________________________________________
CLSQL-Devel mailing list
[email protected]
http://lists.b9.com/mailman/listinfo/clsql-devel

clsql-openmcl-type.diff (application/octet-stream, 2.3 KB)

--- clsql-3.5.7/sql/metaclasses.lisp	2006-02-28 08:07:59.000000000 -0800
+++ clsql-devel/sql/metaclasses.lisp	2006-05-07 17:02:56.000000000 -0700
@@ -386,31 +386,33 @@
   ;; 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
-  (cond
-    ((consp specified-type)
-     (cond
-       ((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)
-    ((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))
-    (t
-     specified-type)))
+  (let ((type
+         (cond
+           ((consp specified-type)
+            (cond
+              ((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)
+           ((eq (ensure-keyword specified-type) :char)
+            'character)
+           ((eq (ensure-keyword specified-type) :varchar)
+            'string)
+           (t
+            specified-type)))
+        (constraints (slot-value slotd 'db-constraints)))
+    (if (and type (not (member :not-null (listify constraints))))
+        `(or null ,type)
+        type)))
 
 ;; Compute the slot definition for slots in a view-class.  Figures out
 ;; what kind of database value (if any) is stored there, generates and