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

diff --git a/sql/expressions.lisp b/sql/expressions.lisp
index 7389d1c06470690d04943ffa8b077d8bf1cb08e2..fd04d42ee8c09039e39f7ea35138e35f103ddce8 100644 (file)
--- a/sql/expressions.lisp
+++ b/sql/expressions.lisp
@@ -980,6 +980,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 "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)
    (cons (symbol-name-default-case "UNIQUE") "UNIQUE")))
 
 (defmethod database-constraint-statement (constraint-list database)


@@ -999,6 +1000,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))))
                        :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 " "))))))))
 
             (if (< 1 (length constraint))
                 (setq string (concatenate 'string string " "))))))))
 

diff --git a/sql/oodml.lisp b/sql/oodml.lisp
index b6f4b417185961e6c3eefac98bf346bbcf13eee9..0ddaabad5d5444eda23851945f018cf7d9a3bd67 100644 (file)
--- a/sql/oodml.lisp
+++ b/sql/oodml.lisp
@@ -251,6 +251,12 @@
                        (slot-definition s))
             when (sstoredp sd)
               collect sd))
                        (slot-definition s))
             when (sstoredp sd)
               collect sd))

+      ;; 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))))

       ;;this may just be a NOP.
       (setf (slot-value obj 'view-database) database)))
 
       ;;this may just be a NOP.
       (setf (slot-value obj 'view-database) database)))
 

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)
   ((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)
 
 (defun initialize-ds-artists ()
    ;   (start-sql-recording :type :both)

diff --git a/tests/test-oodml.lisp b/tests/test-oodml.lisp
index 07d9017a5d471a14e32a6cbf7fa46be9332e008d..8aab53799e5da8ed482439adb5c7af76b53ecdb7 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)
 
       (length (clsql:select 'artist :flatp t :caching nil)))
   0)
 

+
+

 ;; test retrieval is deferred
 (deftest :oodm/retrieval/1
     (with-dataset *ds-employees*
 ;; 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*
 ;; 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)))
       (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]]
          (employee-email
           (car (clsql:select 'employee
                              :where [= 1 [slot-value 'employee 'emplid]]


@@ -625,6 +628,12 @@
       (list (name artist1) (artist_id artist1)))
   ("Mogwai" 1))
 
       (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*
 ;; tests update-instance-from-records
 (deftest :oodml/update-instance/1
     (with-dataset *ds-employees*