X-Git-Url: http://git.kpe.io/?p=clsql.git;a=blobdiff_plain;f=sql%2Fmetaclasses.lisp;h=ddaee4f0dc1da84bd7276c1e0f7e17ecbdcbb0f9;hp=df3c36e0e12f51836fc21e9c3557e0e02ce7cee3;hb=2edf7f68a1dc681db575cda999283cac7e290a77;hpb=f1d668746523a72a6893a46380468a9e033545e4

diff --git a/sql/metaclasses.lisp b/sql/metaclasses.lisp
index df3c36e..ddaee4f 100644
--- a/sql/metaclasses.lisp
+++ b/sql/metaclasses.lisp
@@ -457,7 +457,10 @@ implementations."
 (defmethod initialize-instance :after
     ((obj view-class-direct-slot-definition)
      &key &allow-other-keys)
-  (setf (view-class-slot-column obj) (compute-column-name obj)))
+  (setf (view-class-slot-column obj) (compute-column-name obj)
+        (view-class-slot-autoincrement-sequence obj)
+        (dequote
+         (view-class-slot-autoincrement-sequence obj))))
 
 (defmethod compute-effective-slot-definition ((class standard-db-class)
                                               #+kmr-normal-cesd slot-name
@@ -472,32 +475,22 @@ implementations."
         (view-class-slot-definition-mixin
          (setf (slot-value esd 'column) (compute-column-name dsd))
 
-         (setf (slot-value esd 'db-type)
-           (when (slot-boundp dsd 'db-type)
-             (delistify-dsd
-              (view-class-slot-db-type dsd))))
-
-         (setf (slot-value esd 'void-value)
-               (delistify-dsd
-                (view-class-slot-void-value dsd)))
-
-         ;; :db-kind slot value defaults to :base (store slot value in
-         ;; database)
-
-         (setf (slot-value esd 'db-kind)
-           (if (slot-boundp dsd 'db-kind)
-               (delistify-dsd (view-class-slot-db-kind dsd))
-             :base))
-
-         (setf (slot-value esd 'db-reader)
-           (when (slot-boundp dsd 'db-reader)
-             (delistify-dsd (view-class-slot-db-reader dsd))))
-         (setf (slot-value esd 'db-writer)
-           (when (slot-boundp dsd 'db-writer)
-             (delistify-dsd (view-class-slot-db-writer dsd))))
-         (setf (slot-value esd 'db-constraints)
-           (when (slot-boundp dsd 'db-constraints)
-             (delistify-dsd (view-class-slot-db-constraints dsd))))
+         (macrolet
+             ((safe-copy-value (name &optional default)
+                (let ((fn (intern (format nil "~A~A" 'view-class-slot- name ))))
+                  `(setf (slot-value esd ',name)
+                    (or (when (slot-boundp dsd ',name)
+                          (delistify-dsd (,fn dsd)))
+                     ,default)))))
+           (safe-copy-value autoincrement-sequence)
+           (safe-copy-value db-type)
+           (safe-copy-value void-value)
+           (safe-copy-value db-reader)
+           (safe-copy-value db-writer)
+           ;; :db-kind slot value defaults to :base (store slot value in
+           ;; database)
+           (safe-copy-value db-kind :base)
+           (safe-copy-value db-constraints))
 
          ;; I wonder if this slot option and the previous could be merged,
          ;; so that :base and :key remain keyword options, but :db-kind
@@ -577,10 +570,12 @@ implementations."
                                 &optional database find-class-p)
   "the majority of this function is in expressions.lisp
    this is here to make loading be less painful (try-recompiles) in SBCL"
+  (declare (ignore find-class-p))
   (database-identifier (view-table name) database))
 
 (defmethod database-identifier ((name view-class-slot-definition-mixin)
                                 &optional database find-class-p)
+  (declare (ignore find-class-p))
   (database-identifier
    (if (slot-boundp name 'column)
        (delistify-dsd (view-class-slot-column name))