From 23b76563b25a517ad20f29d6dc5a65c8b958a042 Mon Sep 17 00:00:00 2001 From: "Kevin M. Rosenberg" Date: Wed, 21 Apr 2004 07:25:12 +0000 Subject: [PATCH] r9119: Automated commit for Debian build of clsql upstream-version-2.9.2 --- ChangeLog | 16 +++++ base/db-interface.lisp | 36 ++++++++++- base/package.lisp | 8 ++- db-aodbc/aodbc-sql.lisp | 5 ++ db-mysql/mysql-client-info.lisp | 23 ++++--- db-mysql/mysql-sql.lisp | 18 +++++- db-odbc/odbc-sql.lisp | 42 +++++++++--- db-sqlite/sqlite-sql.lisp | 20 ++++-- debian/changelog | 6 ++ sql/classes.lisp | 11 +++- sql/package.lisp | 16 ++++- sql/table.lisp | 7 +- tests/test-basic.lisp | 4 +- tests/test-fddl.lisp | 109 ++++++++++++++++---------------- tests/test-fdml.lisp | 37 +++++------ tests/test-init.lisp | 44 +++++++++++-- tests/test-ooddl.lisp | 4 +- 17 files changed, 280 insertions(+), 126 deletions(-) diff --git a/ChangeLog b/ChangeLog index a6d4a4a..6797204 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,19 @@ +21 Apr 2004 Kevin Rosenberg (kevin@rosenberg.net) + * Version 2.9.2: Improvments in database capability introspection + and querying. Support transactions in MySQL where available. + All tests now pass on MySQL and SQLite in addition to postgresql + and postgresql-socket. ODBC fails only with OODDL/TIME/1 and OODDL/TIME/2. + * db-odbc/odbc-sql.lisp: Add DATABASE-LIST-VIEWS. Better support + DATABASE-LIST-SEQUENCES. + * clsql-uffi.asd, clsql-mysql.asd: Improve shared library loading + * Database_capabilies: add HAS-VIEWS, HAS-CREATE/DESTROY-DB, + HAS-BOOLEAN-WHERE, TRANSACTION-CAPABLE + * tests/*.lisp: Check database capabilities and remove tests which + the database backend does not support + * sql/table.lisp: Add :TRANSACTIONS keyword to create table which + controls whether InnoDB tables will be created when supported on + the underlying MySQL server. + 20 Apr 2004 Kevin Rosenberg (kevin@rosenberg.net) * Version 2.9.0: New API function: LIST-TABLE-INDEXES, supported by all database backends (except AODBC since diff --git a/base/db-interface.lisp b/base/db-interface.lisp index 3bf550c..9591c9c 100644 --- a/base/db-interface.lisp +++ b/base/db-interface.lisp @@ -211,13 +211,43 @@ the given lisp type and parameters.")) (database-type database)) (:documentation "Returns the type of the underlying database. For ODBC, needs to query ODBC driver.")) -(defgeneric db-use-column-on-drop-index? (db-type) +(defgeneric db-type-use-column-on-drop-index? (db-type) (:method (db-type) (declare (ignore db-type)) - ;; Standard SQL does not use column name on DROP INDEX nil) - (:documentation "NIL [default] lif database-type does not use column name on DROP INDEX.")) + (:documentation "NIL [default] if database-type does not use column name on DROP INDEX.")) +(defgeneric db-type-has-views? (db-type) + (:method (db-type) + (declare (ignore db-type)) + ;; SQL92 has views + t) + (:documentation "T [default] if database-type supports views.")) + +(defgeneric db-type-has-subqueries? (db-type) + (:method (db-type) + (declare (ignore db-type)) + t) + (:documentation "T [default] if database-type supports views.")) + +(defgeneric db-type-has-boolean-where? (db-type) + (:method (db-type) + (declare (ignore db-type)) + ;; SQL92 has boolean where + t) + (:documentation "T [default] if database-type supports boolean WHERE clause, such as 'WHERE MARRIED'.")) + +(defgeneric db-backend-has-create/destroy-db? (db-type) + (:method (db-type) + (declare (ignore db-type)) + t) + (:documentation "T [default] if backend can destroy and create databases.")) + +(defgeneric db-type-transaction-capable? (db database) + (:method (db database) + (declare (ignore db database)) + t) + (:documentation "T [default] if database can supports transactions.")) ;;; Large objects support (Marc Battyani) diff --git a/base/package.lisp b/base/package.lisp index 7f57eab..5d460b8 100644 --- a/base/package.lisp +++ b/base/package.lisp @@ -287,8 +287,12 @@ #:transaction ;; Database features specialized by backend - #:db-use-column-on-drop-index? - + #:db-type-use-column-on-drop-index? + #:db-type-has-views? + #:db-type-has-subqueries? + #:db-type-has-boolean-where? + #:db-backend-has-create/destroy-db? + #:db-type-transaction-capable? )) (:documentation "This is the INTERNAL SQL-Interface package of CLSQL-BASE.")) diff --git a/db-aodbc/aodbc-sql.lisp b/db-aodbc/aodbc-sql.lisp index bbe655e..7d49c7d 100644 --- a/db-aodbc/aodbc-sql.lisp +++ b/db-aodbc/aodbc-sql.lisp @@ -273,6 +273,11 @@ (defmethod database-probe (connection-spec (type (eql :aodbc))) (warn "Not implemented.")) +;;; Backend capabilities + +(defmethod db-backend-has-create/destroy-db? ((db-type (eql :aodbc))) + nil) + #+ignore (when (clsql-base-sys:database-type-library-loaded :aodbc) (clsql-base-sys:initialize-database-type :database-type :aodbc)) diff --git a/db-mysql/mysql-client-info.lisp b/db-mysql/mysql-client-info.lisp index 9b20182..5cb8d0e 100644 --- a/db-mysql/mysql-client-info.lisp +++ b/db-mysql/mysql-client-info.lisp @@ -21,22 +21,21 @@ (declaim (inline mysql-get-client-info)) +(defvar *mysql-client-info* nil) + (eval-when (:compile-toplevel :load-toplevel :execute) (uffi:def-function "mysql_get_client_info" () :module "mysql" :returning :cstring) - (let ((version (uffi:convert-from-cstring (mysql-get-client-info)))) - (cond - ((eql (schar version 0) #\3) - (pushnew :mysql-client-v3 cl:*features*)) - ((eql (schar version 0) #\4) - (pushnew :mysql-client-v4 cl:*features*)) - (t - (error "Unknown mysql client version '~A'." version))))) - -;;#-(or :mysql-client-v3 :mysql-client-v4) -;;(eval-when (:compile-toplevel :load-toplevel :execute) -;; (pushnew :mysql-client-v3 cl:*features*)) + (setf *mysql-client-info* (uffi:convert-from-cstring (mysql-get-client-info))) + + (cond + ((eql (schar *mysql-client-info* 0) #\3) + (pushnew :mysql-client-v3 cl:*features*)) + ((eql (schar *mysql-client-info* 0) #\4) + (pushnew :mysql-client-v4 cl:*features*)) + (t + (error "Unknown mysql client version '~A'." *mysql-client-info*)))) diff --git a/db-mysql/mysql-sql.lisp b/db-mysql/mysql-sql.lisp index 4654492..7f88875 100644 --- a/db-mysql/mysql-sql.lisp +++ b/db-mysql/mysql-sql.lisp @@ -421,9 +421,25 @@ ;;; Database capabilities -(defmethod db-use-column-on-drop-index? ((db-type (eql :mysql))) +(defmethod db-type-use-column-on-drop-index? ((db-type (eql :mysql))) t) +(defmethod db-type-has-views? ((db-type (eql :mysql))) + ;; MySQL 4.1 will apparently have views, need to check *mysql-client-info* + nil) + +(defmethod db-type-has-subqueries? ((db-type (eql :mysql))) + ;; MySQL 4.1 will apparently have subqueries, need to check *mysql-client-info* + nil) + +(defmethod db-type-has-boolean-where? ((db-type (eql :mysql))) + nil) + +(defmethod db-type-transaction-capable? ((db-type (eql :mysql)) database) + (let ((has-innodb (caar (database-query "SHOW VARIABLES LIKE 'HAVE_INNODB'" database :auto)))) + (and has-innodb (string-equal "YES" has-innodb)))) + + (when (clsql-base-sys:database-type-library-loaded :mysql) (clsql-base-sys:initialize-database-type :database-type :mysql)) diff --git a/db-odbc/odbc-sql.lisp b/db-odbc/odbc-sql.lisp index 51d366b..825b743 100644 --- a/db-odbc/odbc-sql.lisp +++ b/db-odbc/odbc-sql.lisp @@ -61,7 +61,7 @@ :error "Connection failed"))))) (defmethod database-underlying-type ((database odbc-database)) - (odbc-db-type database)) + (database-odbc-db-type database)) (defun store-type-of-connected-database (db) (let* ((odbc-conn (database-odbc-conn db)) @@ -193,9 +193,18 @@ (defmethod database-list-sequences ((database odbc-database) &key (owner nil)) (declare (ignore owner)) - (mapcar #'(lambda (s) (%table-name-to-sequence-name (car s))) - (database-query "SHOW TABLES LIKE '%clsql_seq%'" - database nil))) + ;; FIXME: Underlying database backend stuff should come from that backend + ;; Would need to use ASDF to ensure underlying backend was loaded + + (case (database-odbc-db-type database) + (:mysql + (mapcar #'(lambda (s) (%table-name-to-sequence-name (car s))) + (database-query "SHOW TABLES LIKE '%clsql_seq%'" + database nil))) + ((:postgresql :postgresql-socket) + (mapcar #'(lambda (s) (%table-name-to-sequence-name (car s))) + (database-query "SELECT RELNAME FROM pg_class WHERE RELNAME LIKE '%clsql_seq%'" + database nil))))) (defmethod database-list-tables ((database odbc-database) &key (owner nil)) @@ -210,6 +219,19 @@ (string-equal "TABLE" (nth 3 row))) collect (nth 2 row)))) +(defmethod database-list-views ((database odbc-database) + &key (owner nil)) + (declare (ignore owner)) + (multiple-value-bind (rows col-names) + (odbc-dbi:list-all-database-tables :db (database-odbc-conn database)) + (declare (ignore col-names)) + ;; TABLE_SCHEM is hard-coded in second column by ODBC Driver Manager + ;; TABLE_NAME in third column, TABLE_TYPE in fourth column + (loop for row in rows + when (and (not (string-equal "information_schema" (nth 1 row))) + (string-equal "VIEW" (nth 3 row))) + collect (nth 2 row)))) + (defmethod database-list-attributes ((table string) (database odbc-database) &key (owner nil)) (declare (ignore owner)) @@ -307,12 +329,16 @@ (loop-rows rows (cdr loop-rows))) ((null loop-rows) (nreverse results)) (let* ((row (car loop-rows)) - (col (nth 5 row)) - (type (nth 3 row))) - (unless (or (find col results :test #'string-equal) - #+ignore (equal "0" type)) + (col (nth 5 row))) + (unless (find col results :test #'string-equal) (push col results)))))) +;;; Database capabilities + +(defmethod db-backend-has-create/destroy-db? ((db-type (eql :odbc))) + nil) + + (defmethod database-initialize-database-type ((database-type (eql :odbc))) ;; nothing to do t) diff --git a/db-sqlite/sqlite-sql.lisp b/db-sqlite/sqlite-sql.lisp index 5a902c9..9136461 100644 --- a/db-sqlite/sqlite-sql.lisp +++ b/db-sqlite/sqlite-sql.lisp @@ -210,13 +210,14 @@ (defmethod database-list-table-indexes (table (database sqlite-database) &key (owner nil)) (declare (ignore owner)) - (mapcar #'car - (database-query - (format - nil - "SELECT name FROM sqlite_master WHERE type='index' AND tbl_name='~A' UNION ALL SELECT name FROM sqlite_temp_master WHERE type='index' AND tbl_name='~A' ORDER BY name" - table table) - database nil))) + (let ((*print-circle* nil)) + (mapcar #'car + (database-query + (format + nil + "SELECT name FROM sqlite_master WHERE type='index' AND tbl_name='~A' UNION ALL SELECT name FROM sqlite_temp_master WHERE type='index' AND tbl_name='~A' ORDER BY name" + table table) + database nil)))) (declaim (inline sqlite-table-info)) (defun sqlite-table-info (table database) @@ -332,5 +333,10 @@ (or (string-equal ":memory:" name) (and (probe-file name) t)))) +;;; Database capabilities + +(defmethod db-type-has-boolean-where? ((db-type (eql :sqlite))) + nil) + diff --git a/debian/changelog b/debian/changelog index 584afe2..1923b77 100644 --- a/debian/changelog +++ b/debian/changelog @@ -1,3 +1,9 @@ +cl-sql (2.9.2-1) unstable; urgency=low + + * New upstream + + -- Kevin M. Rosenberg Wed, 21 Apr 2004 00:46:34 -0600 + cl-sql (2.9.1-1) unstable; urgency=low * Fix shared library loading in .asd files (closes:245004) diff --git a/sql/classes.lisp b/sql/classes.lisp index 7098ca2..558127a 100644 --- a/sql/classes.lisp +++ b/sql/classes.lisp @@ -630,6 +630,9 @@ uninclusive, and the args from that keyword to the end." :initform nil) (modifiers :initarg :modifiers + :initform nil) + (transactions + :initarg :transactions :initform nil)) (:documentation "An SQL CREATE TABLE statement.")) @@ -658,7 +661,7 @@ uninclusive, and the args from that keyword to the end." (when constraints (write-string " " *sql-stream*) (write-string constraints *sql-stream*))))))) - (with-slots (name columns modifiers) + (with-slots (name columns modifiers transactions) stmt (write-string "CREATE TABLE " *sql-stream*) (output-sql name database) @@ -673,7 +676,11 @@ uninclusive, and the args from that keyword to the end." ((null modifier)) (write-string ", " *sql-stream*) (write-string (car modifier) *sql-stream*))) - (write-char #\) *sql-stream*))) + (write-char #\) *sql-stream*) + (when (and (eq :mysql (database-underlying-type database)) + transactions + (db-type-transaction-capable? :mysql database)) + (write-string " Type=InnoDB" *sql-stream*)))) t) diff --git a/sql/package.lisp b/sql/package.lisp index 1a17ce6..6a11503 100644 --- a/sql/package.lisp +++ b/sql/package.lisp @@ -233,8 +233,13 @@ #:transaction ;; Database capabilities - #:db-use-column-on-drop-index? - + #:db-type-use-column-on-drop-index? + #:db-backend-has-create/destroy-db? + #:db-type-has-views? + #:db-type-has-subqueries? + #:db-type-has-boolean-where? + #:db-type-transaction-capable? + #:database-underlying-type )) (:export ;; "Private" exports for use by interface packages @@ -265,6 +270,13 @@ #:database-list-attributes #:database-attribute-type #:database-describe-table + + #:db-backend-has-create/destroy-db? + #:db-type-has-views? + #:db-type-has-subqueries? + #:db-type-has-boolean-where? + #:db-type-transaction-capable? + #:database-underlying-type . ;; Shared exports for re-export by CLSQL. diff --git a/sql/table.lisp b/sql/table.lisp index dd5ccb9..d51960e 100644 --- a/sql/table.lisp +++ b/sql/table.lisp @@ -33,7 +33,7 @@ ;; Tables (defun create-table (name description &key (database *default-database*) - (constraints nil)) + (constraints nil) (transactions t)) "Create a table called NAME, in DATABASE which defaults to *DEFAULT-DATABASE*, containing the attributes in DESCRIPTION which is a list containing lists of attribute-name and type information pairs." @@ -44,7 +44,8 @@ a list containing lists of attribute-name and type information pairs." (stmt (make-instance 'sql-create-table :name table-name :columns description - :modifiers constraints))) + :modifiers constraints + :transactions transactions))) (execute-command stmt :database database))) (defun drop-table (name &key (if-does-not-exist :error) @@ -173,7 +174,7 @@ specification of a table to drop the index from." (unless (index-exists-p index-name :database database) (return-from drop-index))) (:error t)) - (unless (db-use-column-on-drop-index? (database-underlying-type database)) + (unless (db-type-use-column-on-drop-index? (database-underlying-type database)) (setq on nil)) (execute-command (format nil "DROP INDEX ~A~A" index-name (if (null on) "" diff --git a/tests/test-basic.lisp b/tests/test-basic.lisp index a13c76e..2a63c77 100644 --- a/tests/test-basic.lisp +++ b/tests/test-basic.lisp @@ -84,7 +84,7 @@ (clsql:execute-command "DROP TABLE test_clsql" :database db)) (clsql:execute-command - "CREATE TABLE test_clsql (t_int integer, t_float double precision, t_bigint BIGINT, t_str CHAR(30))" + "CREATE TABLE test_clsql (t_int integer, t_float double precision, t_bigint BIGINT, t_str VARCHAR(30))" :database db) (dotimes (i 11) (let* ((test-int (- i 5)) @@ -113,7 +113,7 @@ ((eq types :auto) (test (and (integerp int) (typep float 'double-float) - (or (eq db-type :aodbc) ;; aodbc considers bigints as strings + (or (member db-type '(:odbc :aodbc)) ;; aodbc considers bigints as strings (integerp bigint)) (stringp str)) t diff --git a/tests/test-fddl.lisp b/tests/test-fddl.lisp index 98cd216..2cb4b2b 100644 --- a/tests/test-fddl.lisp +++ b/tests/test-fddl.lisp @@ -79,73 +79,69 @@ "birthday" "companyid" "email" "emplid" "first_name" "groupid" "height" "last_name" "managerid" "married") -;; create a view, test for existence, drop it and test again +;; create a view, test for existence, drop it and test again (deftest :fddl/view/1 (progn (clsql:create-view [lenins-group] - ;;not in sqlite - ;;:column-list '([forename] [surname] [email]) - :as [select [first-name] [last-name] [email] - :from [employee] - :where [= [managerid] 1]]) - (values - (clsql:view-exists-p [lenins-group] :owner *test-database-user*) - (progn - (clsql:drop-view [lenins-group] :if-does-not-exist :ignore) - (clsql:view-exists-p [lenins-group] :owner *test-database-user*)))) + :as [select [first-name] [last-name] [email] + :from [employee] + :where [= [managerid] 1]]) + (values + (clsql:view-exists-p [lenins-group] :owner *test-database-user*) + (progn + (clsql:drop-view [lenins-group] :if-does-not-exist :ignore) + (clsql:view-exists-p [lenins-group] :owner *test-database-user*)))) t nil) - -;; create a view, list its attributes and drop it -(deftest :fddl/view/2 - (progn (clsql:create-view [lenins-group] - ;;not in sqlite - ;;:column-list '([forename] [surname] [email]) - :as [select [first-name] [last-name] [email] - :from [employee] - :where [= [managerid] 1]]) - (prog1 - (sort (mapcar #'string-downcase - (clsql:list-attributes [lenins-group])) - #'string<) - (clsql:drop-view [lenins-group] :if-does-not-exist :ignore))) - ("email" "first_name" "last_name")) - -;; create a view, select stuff from it and drop it + + ;; create a view, list its attributes and drop it +(when (clsql-base-sys:db-type-has-views? *test-database-underlying-type*) + (deftest :fddl/view/2 + (progn (clsql:create-view [lenins-group] + :as [select [first-name] [last-name] [email] + :from [employee] + :where [= [managerid] 1]]) + (prog1 + (sort (mapcar #'string-downcase + (clsql:list-attributes [lenins-group])) + #'string<) + (clsql:drop-view [lenins-group] :if-does-not-exist :ignore))) + ("email" "first_name" "last_name"))) + + ;; create a view, select stuff from it and drop it (deftest :fddl/view/3 (progn (clsql:create-view [lenins-group] - :as [select [first-name] [last-name] [email] - :from [employee] - :where [= [managerid] 1]]) - (let ((result - (list - ;; Shouldn't exist - (clsql:select [first-name] [last-name] [email] - :from [lenins-group] - :where [= [last-name] "Lenin"]) - ;; Should exist - (car (clsql:select [first-name] [last-name] [email] - :from [lenins-group] - :where [= [last-name] "Stalin"]))))) - (clsql:drop-view [lenins-group] :if-does-not-exist :ignore) - (apply #'values result))) + :as [select [first-name] [last-name] [email] + :from [employee] + :where [= [managerid] 1]]) + (let ((result + (list + ;; Shouldn't exist + (clsql:select [first-name] [last-name] [email] + :from [lenins-group] + :where [= [last-name] "Lenin"]) + ;; Should exist + (car (clsql:select [first-name] [last-name] [email] + :from [lenins-group] + :where [= [last-name] "Stalin"]))))) + (clsql:drop-view [lenins-group] :if-does-not-exist :ignore) + (apply #'values result))) nil ("Josef" "Stalin" "stalin@soviet.org")) - -;; not in sqlite + (deftest :fddl/view/4 (progn (clsql:create-view [lenins-group] - :column-list '([forename] [surname] [email]) - :as [select [first-name] [last-name] [email] - :from [employee] - :where [= [managerid] 1]]) + :column-list '([forename] [surname] [email]) + :as [select [first-name] [last-name] [email] + :from [employee] + :where [= [managerid] 1]]) (let ((result (list ;; Shouldn't exist - (clsql:select [forename] [surname] [email] - :from [lenins-group] - :where [= [surname] "Lenin"]) - ;; Should exist - (car (clsql:select [forename] [surname] [email] - :from [lenins-group] - :where [= [surname] "Stalin"]))))) + (clsql:select [forename] [surname] [email] + :from [lenins-group] + :where [= [surname] "Lenin"]) + ;; Should exist + (car (clsql:select [forename] [surname] [email] + :from [lenins-group] + :where [= [surname] "Stalin"]))))) (clsql:drop-view [lenins-group] :if-does-not-exist :ignore) (apply #'values result))) nil ("Josef" "Stalin" "stalin@soviet.org")) @@ -193,6 +189,7 @@ (progn (clsql:drop-index [bar] :on [i3test]) (clsql:drop-index [foo] :on [i3test]) + (clsql:execute-command "DROP TABLE I3TEST") t))) ("bar" "foo") nil t) diff --git a/tests/test-fdml.lisp b/tests/test-fdml.lisp index 1e2a92b..81fea97 100644 --- a/tests/test-fdml.lisp +++ b/tests/test-fdml.lisp @@ -221,7 +221,7 @@ (deftest :fdml/select/10 (clsql:select [last-name] :from [employee] :where [not [in [emplid] - [select [managerid] :from [company]]]] + [select [managerid] :from [company]]]] :flatp t :order-by [last-name]) ("Andropov" "Brezhnev" "Chernenko" "Gorbachev" "Kruschev" "Putin" "Stalin" @@ -285,8 +285,7 @@ ;; test if we are in a transaction (push (clsql:in-transaction-p) results) ;;Putin has got to go - (unless (eql *test-database-type* :mysql) - (clsql:delete-records :from [employee] :where [= [last-name] "Putin"])) + (clsql:delete-records :from [employee] :where [= [last-name] "Putin"]) ;;Should be nil (push (clsql:select [*] :from [employee] :where [= [last-name] "Putin"]) @@ -312,10 +311,9 @@ ;; test if we are in a transaction (push (clsql:in-transaction-p) results) ;;Putin has got to go - (unless (eql *test-database-type* :mysql) - (clsql:update-records [employee] - :av-pairs '((email "putin-nospam@soviet.org")) - :where [= [last-name] "Putin"])) + (clsql:update-records [employee] + :av-pairs '((email "putin-nospam@soviet.org")) + :where [= [last-name] "Putin"]) ;;Should be new value (push (clsql:select [email] :from [employee] :where [= [last-name] "Putin"] @@ -373,19 +371,18 @@ (let ((results '())) ;; check status (push (clsql:in-transaction-p) results) - (unless (eql *test-database-type* :mysql) - (handler-case - (clsql:with-transaction () - ;; valid update - (clsql:update-records [employee] - :av-pairs '((email "lenin-nospam@soviet.org")) - :where [= [emplid] 1]) - ;; invalid update which generates an error + (handler-case + (clsql:with-transaction () + ;; valid update + (clsql:update-records [employee] + :av-pairs '((email "lenin-nospam@soviet.org")) + :where [= [emplid] 1]) + ;; invalid update which generates an error (clsql:update-records [employee] - :av-pairs - '((emale "lenin-nospam@soviet.org")) - :where [= [emplid] 1])) - (clsql:clsql-sql-error () + :av-pairs + '((emale "lenin-nospam@soviet.org")) + :where [= [emplid] 1])) + (clsql:clsql-error () (progn ;; check status (push (clsql:in-transaction-p) results) @@ -393,7 +390,7 @@ (push (clsql:select [email] :from [employee] :where [= [emplid] 1] :flatp t) results) - (apply #'values (nreverse results))))))) + (apply #'values (nreverse results)))))) nil nil ("lenin@soviet.org")) )) diff --git a/tests/test-init.lisp b/tests/test-init.lisp index 964849c..0584762 100644 --- a/tests/test-init.lisp +++ b/tests/test-init.lisp @@ -25,6 +25,7 @@ (defvar *rt-time*) (defvar *test-database-type* nil) +(defvar *test-database-underlying-type* nil) (defvar *test-database-user* nil) (defclass thing () @@ -128,7 +129,12 @@ (clsql:connect spec :database-type database-type :make-default t - :if-exists :old)) + :if-exists :old) + + (setf *test-database-underlying-type* + (clsql-sys:database-underlying-type *default-database*)) + + *default-database*) (defparameter company1 nil) (defparameter employee1 nil) @@ -319,13 +325,39 @@ (test-basic spec db-type)) (incf *error-count* *test-errors*) - (ignore-errors (destroy-database spec :database-type db-type)) - (ignore-errors (create-database spec :database-type db-type)) + (when (db-backend-has-create/destroy-db? db-type) + (ignore-errors (destroy-database spec :database-type db-type)) + (ignore-errors (create-database spec :database-type db-type))) - (dolist (test (append *rt-connection* *rt-fddl* *rt-fdml* - *rt-ooddl* *rt-oodml* *rt-syntax*)) - (eval test)) (test-connect-to-database db-type spec) + + (dolist (test-form (append *rt-connection* *rt-fddl* *rt-fdml* + *rt-ooddl* *rt-oodml* *rt-syntax*)) + (let ((test (second test-form))) + (cond + ((and (null (db-type-has-views? *test-database-underlying-type*)) + (clsql-base-sys::in test :fddl/view/1 :fddl/view/2 :fddl/view/3 :fddl/view/4)) + ;; skip test + ) + ((and (null (db-type-has-boolean-where? *test-database-underlying-type*)) + (clsql-base-sys::in test :fdml/select/11 :oodml/select/5)) + ;; skip tests + ) + ((and (null (db-type-has-subqueries? *test-database-underlying-type*)) + (clsql-base-sys::in test :fdml/select/5 :fdml/select/10)) + ;; skip tests + ) + ((and (null (db-type-transaction-capable? *test-database-underlying-type* *default-database*)) + (clsql-base-sys::in test :fdml/transaction/1 :fdml/transaction/2 :fdml/transaction/3 :fdml/transaction/4)) + ;; skip tests + ) + ((and (eql *test-database-type* :sqlite) + (clsql-base-sys::in test :fddl/view/4 :fdml/select/10)) + ;; skip tests + ) + (t + (eval test-form))))) + (test-initialise-database) (let ((remaining (rtest:do-tests))) (when (consp remaining) diff --git a/tests/test-ooddl.lisp b/tests/test-ooddl.lisp index 9883b7a..feb827b 100644 --- a/tests/test-ooddl.lisp +++ b/tests/test-ooddl.lisp @@ -63,7 +63,7 @@ (deftest :ooddl/time/1 (let* ((now (clsql-base:get-time))) - (when (member *test-database-type* '(:postgresql :postgresql-socket)) + (when (member *test-database-underlying-type* '(:postgresql :postgresql-socket)) (clsql:execute-command "set datestyle to 'iso'")) (clsql:update-records [employee] :av-pairs `((birthday ,now)) :where [= [emplid] 1]) @@ -76,7 +76,7 @@ (deftest :ooddl/time/2 (let* ((now (clsql-base:get-time)) (fail-index -1)) - (when (member *test-database-type* '(:postgresql :postgresql-socket)) + (when (member *test-database-underlying-type* '(:postgresql :postgresql-socket)) (clsql:execute-command "set datestyle to 'iso'")) (dotimes (x 40) (clsql:update-records [employee] :av-pairs `((birthday ,now)) -- 2.34.1