cleaning up patches, and fixing missing pkey bugs in sqlite3

 * clean make-constraint-description and database-translate-constraint
 * clean tests and run

diff --git a/ChangeLog b/ChangeLog
index 5aade9e229473fcc3ef952b3676e34feb49dc9e5..de4f87c2357713e16f385724cae441667bdac6da 100644 (file)
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,9 @@
+2014-01-07 Russ Tyndall <russ@acceleration.net>
+       * clsql-uffi.lisp, sqlite3 auto-increment support
+       * clsql-uffi.lisp, test-basic.lisp, fixes related to unsigned vs
+          signed ints (thanks Aaron Burrows)
+       * cleaning and testing
+
 2013-09-27 Russ Tyndall <russ@acceleration.net>
        * fixed bug converting to boolean in db-mysql/mysql-sql.lisp
        from github user Sectoid https://github.com/UnwashedMeme/clsql/pull/1

diff --git a/db-sqlite3/sqlite3-methods.lisp b/db-sqlite3/sqlite3-methods.lisp
index 181fca43b894b733c63cddd4f6a7d0e0664f3df3..5ce0ac21759c3d632a452f434c1231d96b0c3ea4 100644 (file)
--- a/db-sqlite3/sqlite3-methods.lisp
+++ b/db-sqlite3/sqlite3-methods.lisp
@@ -2,19 +2,19 @@
 
 (in-package #:clsql-sys)
 
-;; This method generates primary key constraints part of the table
-;; definition. For Sqlite autoincrement primary keys to work properly
-;; this part of the table definition must be left out.
-(defmethod database-pkey-constraint ((class standard-db-class)
-                                    (database clsql-sqlite3:sqlite3-database)))
 
-(defmethod database-translate-constraint (constraint
-                                         (database clsql-sqlite3:sqlite3-database))
-  ;; Primary purpose of this is method is to intecept and translate
-  ;; auto-increment primary keys constraints.
-  (let ((constraint-name (symbol-name constraint)))
-    (if (eql constraint :auto-increment)
-       (cons constraint "PRIMARY KEY AUTOINCREMENT")
-       (call-next-method))))
+(defmethod database-pkey-constraint ((class standard-db-class)
+                                    (database clsql-sqlite3:sqlite3-database))
+  (let* ((keys (keyslots-for-class class))
+         (cons (when (= 1 (length keys))
+                 (view-class-slot-db-constraints (first keys)))))
+    ;; This method generates primary key constraints part of the table
+    ;; definition. For Sqlite autoincrement primary keys to work properly
+    ;; this part of the table definition must be left out (IFF autoincrement) .
+    (when (or (null cons) ;; didnt have constraints to check
+              ;; didnt have auto-increment
+              (null (intersection
+                     +auto-increment-names+
+                     (listify cons))))
+      (call-next-method))))
 
-;; EOF

diff --git a/sql/expressions.lisp b/sql/expressions.lisp
index 35b163f5c3a91b65088116d0b6ac2dec502cb4c3..10bdb5ec0b2a0dd23e7d85032da5f180e1b45315 100644 (file)
--- a/sql/expressions.lisp
+++ b/sql/expressions.lisp
@@ -1093,49 +1093,40 @@ uninclusive, and the args from that keyword to the end."
 ;;
 ;; Column constraint types and conversion to SQL
 ;;
-
-(defparameter *constraint-types*
-  (list
-   (cons (symbol-name-default-case "NOT-NULL") "NOT NULL")
-   (cons (symbol-name-default-case "PRIMARY-KEY") "PRIMARY KEY")
-   (cons (symbol-name-default-case "NOT") "NOT")
-   (cons (symbol-name-default-case "NULL") "NULL")
-   (cons (symbol-name-default-case "PRIMARY") "PRIMARY")
-   (cons (symbol-name-default-case "KEY") "KEY")
-   (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 "AUTOINCREMENT") "AUTOINCREMENT")
-   (cons (symbol-name-default-case "DEFAULT") "DEFAULT")
-   (cons (symbol-name-default-case "UNIQUE") "UNIQUE")
-   (cons (symbol-name-default-case "IDENTITY") "IDENTITY (1,1)") ;; added for sql-server support
-   ))
-
 (defmethod database-constraint-statement (constraint-list database)
   (make-constraints-description constraint-list database))
 
+;; KEEP THIS SYNCED WITH database-translate-constraint
+(defparameter +auto-increment-names+
+  '(:auto-increment :auto_increment :autoincrement :identity))
+
 (defmethod database-translate-constraint (constraint database)
-  (assoc (symbol-name constraint)
-        *constraint-types*
-        :test #'equal))
-
-(defun make-constraints-description (constraint-list database)
-  (if constraint-list
-      (let ((string ""))
-        (do ((constraint constraint-list (cdr constraint)))
-            ((null constraint) string)
-          (let ((output (database-translate-constraint (car constraint)
-                                                      database)))
-            (if (null output)
-                (error 'sql-user-error
-                       :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 " "))))))))
+  (case constraint
+    (:not-null "NOT NULL")
+    (:primary-key "PRIMARY KEY")
+    ((:auto-increment :auto_increment :autoincrement :identity)
+     (ecase (database-underlying-type database)
+       (:mssql "IDENTITY (1,1)")
+       ((:sqlite :sqlite3) "PRIMARY KEY AUTOINCREMENT")
+       (:mysql "AUTO_INCREMENT")))
+    ;; everything else just get the name
+    (T (string-upcase (symbol-name constraint)))))
+
+(defun make-constraints-description (constraint-list database
+                                     &aux (rest constraint-list) constraint)
+  (when constraint-list
+    (flet ((next ()
+             (setf constraint (first rest)
+                   rest (rest rest))
+             constraint))
+      (with-output-to-string (s)
+        (loop while (next)
+              do (unless (keywordp constraint)
+                   (setf constraint (intern (symbol-name constraint) :keyword)))
+                 (write-string (database-translate-constraint constraint database) s)
+                 (when (eql :default constraint) (princ (next) s))
+                 (write-char #\space s)
+              )))))
 
 (defmethod database-identifier ( name  &optional database find-class-p
                                  &aux cls)

diff --git a/tests/test-basic.lisp b/tests/test-basic.lisp
index 4ccc02d97b11acfc4223412c1ffc1d59d43b5433..4d277e358d14ba2c722940c36e02df888371048d 100644 (file)
--- a/tests/test-basic.lisp
+++ b/tests/test-basic.lisp
@@ -229,14 +229,14 @@
 
     (deftest :basic/reallybigintegers/1
         (with-dataset *ds-reallybigintegers*
-          (let ((a (1- (expt 2 64)))
-                (b (- (expt 2 64) 2))
-                (c (expt 2 63))
-                (d (expt 2 62)))
-            (query
-             (format nil "INSERT INTO testreallybigintegers
+          (let* ((a (1- (expt 2 64)))
+                 (b (- (expt 2 64) 2))
+                 (c (expt 2 63))
+                 (d (expt 2 62))
+                 (sql (format nil "INSERT INTO testreallybigintegers
                               VALUES (~A, ~A, ~A, ~A)"
-                     a b c d))
+                              a b c d)))
+            (query sql)
             (let ((results
                     (query
                      (format nil "SELECT * FROM testreallybigintegers"))))

diff --git a/tests/test-fddl.lisp b/tests/test-fddl.lisp
index 83eada9f1074e699b6e584d90360be9e884be957..f7fb89bed93d967a22513277926f6f76e5d63b61 100644 (file)
--- a/tests/test-fddl.lisp
+++ b/tests/test-fddl.lisp
@@ -44,9 +44,11 @@ B varchar(32))")
 ;; list current tables
 (deftest :fddl/table/1
     (with-dataset *ds-fddl*
-      (sort (mapcar #'string-downcase
-                   (clsql:list-tables ))
-           #'string<))
+      (let ((tables (sort (mapcar #'string-downcase (clsql:list-tables))
+                          #'string<)))
+        ;; sqlite has a table for autoincrement sequences that we dont care about if
+        ;; it exists
+        (remove "sqlite_sequence" tables :test #'string-equal)))
   ("alpha" "bravo"))
 
 ;; create a table, test for its existence, drop it and test again

diff --git a/tests/test-init.lisp b/tests/test-init.lisp
index cd37dac8a7dd3b2e81ae2e027f07f64f6ea4fa82..a12d2144d77c767bc568543b119ba7b4d227a439 100644 (file)
--- a/tests/test-init.lisp
+++ b/tests/test-init.lisp
@@ -262,7 +262,8 @@
           ((and (eql *test-database-type* :sqlite3)
                 (clsql-sys:in test :fddl/view/4 :fdml/select/10
                               :fdml/select/21 :fdml/select/32
-                              :fdml/select/33))
+                              :fdml/select/33
+                              :basic/reallybigintegers/1))
            (push (cons test "not supported by sqlite3.") skip-tests))
           ((and (not (clsql-sys:db-type-has-bigint? db-type))
                 (clsql-sys:in test :basic/bigint/1))