Fix up patches for postgresql autoincrement support to master version.

diff --git a/sql/generic-postgresql.lisp b/sql/generic-postgresql.lisp
index 7716eb209e719c143c96f6b36217b1860530ff7b..83c552f228acd8c9651ec8ca8f5dc071f96e014c 100644 (file)
--- a/sql/generic-postgresql.lisp
+++ b/sql/generic-postgresql.lisp
@@ -428,3 +428,5 @@
 (defmethod db-type-has-prepared-stmt? ((db-type (eql :postgresql-socket)))
   t)
 
+(defmethod db-type-has-auto-increment? ((db-type (eql :postgresql)))
+  t)

diff --git a/sql/oodml.lisp b/sql/oodml.lisp
index b570cedcbb96d6aa8e6ac9b10012ae33e47d2f71..bb6f447d5841444bc0400e1a7675579b5d3d1a07 100644 (file)
--- a/sql/oodml.lisp
+++ b/sql/oodml.lisp
@@ -283,7 +283,7 @@
                    (setf pk (or pk
                                 (slot-value obj (slot-definition-name pk-slot))))))
                 (t
-                 (insert-records :into (sql-expression :table view-class-table)
+                (insert-records :into (sql-expression :table view-class-table)
                                  :av-pairs record-values
                                  :database database)
 
@@ -292,19 +292,26 @@
                                     (not (null (view-class-slot-autoincrement-sequence pk-slot))))
                                 (setf (slot-value obj (slot-definition-name pk-slot))
                                       (database-last-auto-increment-id database
-                                                                      table
+                                                                      view-class-table
                                                                       pk-slot)))))
-                 (setf pk (or pk
-                              (slot-value
-                               obj (slot-definition-name pk-slot)))))
-                 (when (eql this-class nil)
-                   (setf (slot-value obj 'view-database) database))))))
+                 (when pk-slot
+                   (setf pk (or pk
+                                (slot-value
+                                 obj (slot-definition-name pk-slot)))))
+                 (when (eql this-class nil)
+                   (setf (slot-value obj 'view-database) database)))))))
     ;; handle slots with defaults
-    (dolist (slot slots)
-      (when (and (slot-exists-p slot 'db-constraints)
-                (listp (view-class-slot-db-constraints slot))
-                (member :default (view-class-slot-db-constraints slot)))
-       (update-slot-from-record obj (slot-definition-name slot))))
+    (let* ((view-class (or this-class (class-of obj)))
+          (slots (if (normalizedp view-class)
+                    (ordered-class-direct-slots view-class)
+                    (ordered-class-slots view-class)))) 
+      (dolist (slot slots)
+       (when (and (slot-exists-p slot 'db-constraints)
+                  (listp (view-class-slot-db-constraints slot))
+                  (member :default (view-class-slot-db-constraints slot)))
+         (unless (and (slot-boundp obj (slot-definition-name slot))
+                      (slot-value obj (slot-definition-name slot)))
+           (update-slot-from-record obj (slot-definition-name slot))))))
 
     pk))