r9166: Automated commit for clsql debian-version-2.9.4-2

[clsql.git] / sql / objects.lisp

diff --git a/sql/objects.lisp b/sql/objects.lisp
index e1bc241e09cdf26c4be92f3e9d1ff7517052063a..a478e0d37eb4d49694d0f7bd7256a7838be7dad4 100644 (file)
--- a/sql/objects.lisp
+++ b/sql/objects.lisp
@@ -78,9 +78,11 @@
 (defmethod database-pkey-constraint ((class standard-db-class) database)
   (let ((keylist (mapcar #'view-class-slot-column (keyslots-for-class class))))
     (when keylist 
-      (format nil "CONSTRAINT ~APK PRIMARY KEY~A"
-              (database-output-sql (view-table class) database)
-              (database-output-sql keylist database)))))
+      (convert-to-db-default-case
+       (format nil "CONSTRAINT ~APK PRIMARY KEY~A"
+              (database-output-sql (view-table class) database)
+              (database-output-sql keylist database))
+       database))))
 
 
 (defun create-view-from-class (view-class-name
@@ -234,6 +236,7 @@ superclass of the newly-defined View Class."
     (let ((cdef
            (list (sql-expression :attribute (view-class-slot-column slotdef))
                  (slot-type slotdef))))
+      (setf cdef (append cdef (list (view-class-slot-db-type slotdef))))
       (let ((const (view-class-slot-db-constraints slotdef)))
         (when const 
           (setq cdef (append cdef (list const)))))
@@ -543,7 +546,8 @@ DATABASE-NULL-VALUE on the type of the slot."))
 
 (defmethod database-get-type-specifier (type args database)
   (declare (ignore type args))
-  (if (member (database-type database) '(:postgresql :postgresql-socket))
+  (if (clsql-base-sys::in (database-underlying-type database)
+                         :postgresql :postgresql-socket)
           "VARCHAR"
           "VARCHAR(255)"))
 
@@ -558,31 +562,32 @@ DATABASE-NULL-VALUE on the type of the slot."))
                                         database)
   (if args
       (format nil "VARCHAR(~A)" (car args))
-      (if (member (database-type database) '(:postgresql :postgresql-socket))
-          "VARCHAR"
-          "VARCHAR(255)")))
+    (if (clsql-base-sys::in (database-underlying-type database) 
+                           :postgresql :postgresql-socket)
+       "VARCHAR"
+      "VARCHAR(255)")))
 
 (defmethod database-get-type-specifier ((type (eql 'simple-string)) args
                                         database)
   (if args
       (format nil "VARCHAR(~A)" (car args))
-      (if (member (database-type database) '(:postgresql :postgresql-socket))
-          "VARCHAR"
-          "VARCHAR(255)")))
+    (if (clsql-base-sys::in (database-underlying-type database) 
+                           :postgresql :postgresql-socket)
+       "VARCHAR"
+      "VARCHAR(255)")))
 
 (defmethod database-get-type-specifier ((type (eql 'string)) args database)
   (if args
       (format nil "VARCHAR(~A)" (car args))
-      (if (member (database-type database) '(:postgresql :postgresql-socket))
-          "VARCHAR"
-          "VARCHAR(255)")))
+    (if (clsql-base-sys::in (database-underlying-type database) 
+                           :postgresql :postgresql-socket)
+       "VARCHAR"
+      "VARCHAR(255)")))
 
 (defmethod database-get-type-specifier ((type (eql 'wall-time)) args database)
   (declare (ignore args))
-  (case (database-type database)
-    (:postgresql
-     "TIMESTAMP WITHOUT TIME ZONE")
-    (:postgresql-socket
+  (case (database-underlying-type database)
+    ((:postgresql :postgresql-socket)
      "TIMESTAMP WITHOUT TIME ZONE")
     (:mysql
      "DATETIME")
@@ -701,13 +706,14 @@ DATABASE-NULL-VALUE on the type of the slot."))
 (defmethod read-sql-value (val (type (eql 'keyword)) database)
   (declare (ignore database))
   (when (< 0 (length val))
-    (intern (string-upcase val) "KEYWORD")))
+    (intern (symbol-name-default-case val) 
+           (find-package '#:keyword))))
 
 (defmethod read-sql-value (val (type (eql 'symbol)) database)
   (declare (ignore database))
   (when (< 0 (length val))
-    (unless (string= val "NIL")
-      (intern (string-upcase val)
+    (unless (string= val (clsql-base-sys:symbol-name-default-case "NIL"))
+      (intern (clsql-base-sys:symbol-name-default-case val)
               (symbol-package *update-context*)))))
 
 (defmethod read-sql-value (val (type (eql 'integer)) database)