Add support for :default in db constraints. make-constraint-description: use next...

diff --git a/sql/expressions.lisp b/sql/expressions.lisp
index 5e75b01ccdfaaae1842dabe6dea7179cb77674e0..45d4631b5eaccf70b878b49a6b79907b9d4930c4 100644 (file)
--- a/sql/expressions.lisp
+++ b/sql/expressions.lisp
@@ -990,6 +990,7 @@ uninclusive, and the args from that keyword to the end."
    (cons (symbol-name-default-case "UNSIGNED") "UNSIGNED")
    (cons (symbol-name-default-case "ZEROFILL") "ZEROFILL")
    (cons (symbol-name-default-case "AUTO-INCREMENT") "AUTO_INCREMENT")
+   (cons (symbol-name-default-case "DEFAULT") "DEFAULT")
    (cons (symbol-name-default-case "UNIQUE") "UNIQUE")))
 
 (defmethod database-constraint-statement (constraint-list database)
@@ -1009,6 +1010,9 @@ uninclusive, and the args from that keyword to the end."
                        :message (format nil "unsupported column constraint '~A'"
                                         constraint))
                 (setq string (concatenate 'string string (cdr output))))
+           (when (equal (symbol-name (car constraint)) "DEFAULT")
+             (setq constraint (cdr constraint))
+             (setq string (concatenate 'string string " " (car constraint))))
             (if (< 1 (length constraint))
                 (setq string (concatenate 'string string " "))))))))
 

diff --git a/sql/oodml.lisp b/sql/oodml.lisp
index 7bf7d5bf77db5adcb9bed1ca976ca7082a2afebb..dc010fb886cb4507b01a5689bcf415bc9f86906d 100644 (file)
--- a/sql/oodml.lisp
+++ b/sql/oodml.lisp
@@ -287,23 +287,24 @@
                                  :av-pairs record-values
                                  :database database)
 
-                 (when pk-slot
-                   (if (or (and (listp (view-class-slot-db-constraints pk-slot))
-                                (member :auto-increment (view-class-slot-db-constraints pk-slot)))
-                           (eql (view-class-slot-db-constraints pk-slot) :auto-increment))
-                       (unless pk
-                         (let ((db-pk (car (query "SELECT LAST_INSERT_ID();"
-                                                  :flatp t :field-names nil
-                                                  :database database))))
-                           (setf pk db-pk
-                                 (slot-value
-                                  obj (slot-definition-name pk-slot)) db-pk)))
-
-                       (setf pk (or pk
-                                    (slot-value
-                                     obj (slot-definition-name pk-slot))))))
+                 (when (and pk-slot (not pk))
+                   (setf pk (if (member :auto-increment (listify (view-class-slot-db-constraints pk-slot)))
+                                (setf (slot-value obj (slot-definition-name pk-slot))
+                                      (database-last-auto-increment-id database
+                                                                      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)))))))
+                   (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))))
+
     pk))
 
 (defmethod delete-instance-records ((instance standard-db-object))

diff --git a/tests/ds-artists.lisp b/tests/ds-artists.lisp
index 8fe86d2ec2cc4ddcbd6f5752f43284e07c3d52f4..4637fde97a31919d45c45d2d35a3ef2d8a327285 100644 (file)
--- a/tests/ds-artists.lisp
+++ b/tests/ds-artists.lisp
@@ -8,7 +8,8 @@
   ((artist_id :accessor artist_id :initarg :id
              :type integer :db-kind :key :db-constraints (:not-null :auto-increment)
              :autoincrement-sequence 'artist_artist_id_seq)
-   (name :accessor name :initarg :name :type (varchar 20))))
+   (name :accessor name :initarg :name :type (varchar 20))
+   (genre :accessor genre :initarg :genre :type (varchar 10) :db-constraints (:default "'Unknown'"))))
 
 (defun initialize-ds-artists ()
    ;   (start-sql-recording :type :both)

diff --git a/tests/test-oodml.lisp b/tests/test-oodml.lisp
index d1c933a432d75c8340b047651fbe092590457efa..29b80592a9f75948a8cfe8478ca85dc0513ea077 100644 (file)
--- a/tests/test-oodml.lisp
+++ b/tests/test-oodml.lisp
@@ -216,6 +216,8 @@
       (length (clsql:select 'artist :flatp t :caching nil)))
   0)
 
+
+
 ;; test retrieval is deferred
 (deftest :oodm/retrieval/1
     (with-dataset *ds-employees*
@@ -304,15 +306,16 @@
 ;; tests update-record-from-slot
 (deftest :oodml/update-records/2
     (with-dataset *ds-employees*
+      ;(start-sql-recording :type :both)
       (values
        (employee-email
         (car (clsql:select 'employee
                            :where [= 1 [slot-value 'employee 'emplid]]
                            :flatp t
                            :caching nil)))
-       (progn
-         (setf (slot-value employee1 'email) "lenin-nospam@soviet.org")
-         (clsql:update-record-from-slot employee1 'email)
+       (progn
+         (setf (slot-value employee1 'email) "lenin-nospam@soviet.org")
+         (clsql:update-record-from-slot employee1 'email)
          (employee-email
           (car (clsql:select 'employee
                              :where [= 1 [slot-value 'employee 'emplid]]
@@ -625,6 +628,12 @@
       (list (name artist1) (artist_id artist1)))
   ("Mogwai" 1))
 
+(deftest :oodml/update-records/12
+    (with-dataset *ds-artists*
+      (clsql:update-records-from-instance artist1)
+      (list (name artist1) (genre artist1)))
+  ("Mogwai" "Unknown"))
+
 ;; tests update-instance-from-records
 (deftest :oodml/update-instance/1
     (with-dataset *ds-employees*