From 374df8f34a7214e08fc4cfc5d734d024acdbf9ca Mon Sep 17 00:00:00 2001 From: Russ Tyndall Date: Tue, 7 Jan 2014 14:48:41 -0500 Subject: [PATCH] cleaning up patches, and fixing missing pkey bugs in sqlite3 * clean make-constraint-description and database-translate-constraint * clean tests and run --- ChangeLog | 6 +++ db-sqlite3/sqlite3-methods.lisp | 28 ++++++------- sql/expressions.lisp | 69 ++++++++++++++------------------- tests/test-basic.lisp | 14 +++---- tests/test-fddl.lisp | 8 ++-- tests/test-init.lisp | 3 +- 6 files changed, 64 insertions(+), 64 deletions(-) diff --git a/ChangeLog b/ChangeLog index 5aade9e..de4f87c 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,9 @@ +2014-01-07 Russ Tyndall + * 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 * 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 181fca4..5ce0ac2 100644 --- 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 35b163f..10bdb5e 100644 --- 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 4ccc02d..4d277e3 100644 --- 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 83eada9..f7fb89b 100644 --- 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 cd37dac..a12d214 100644 --- 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)) -- 2.34.1