From 0e06463bcfc9e4f9d1eec15b7746eb7f07cf2f2b Mon Sep 17 00:00:00 2001 From: Nathan Bird Date: Wed, 13 Jan 2010 16:56:25 -0500 Subject: [PATCH] First working version of tests with datasets. So far: internal,connection,basic,fddl passed, with one punted from fddl to ooddl (it appeared to be testing the class definition more. --- tests/test-basic.lisp | 346 ++++++++++++++++++----------------- tests/test-fddl.lisp | 414 +++++++++++++++++++++--------------------- tests/test-init.lisp | 28 +-- tests/test-ooddl.lisp | 21 +++ 4 files changed, 426 insertions(+), 383 deletions(-) diff --git a/tests/test-basic.lisp b/tests/test-basic.lisp index cbcd8fa..03ed1e1 100644 --- a/tests/test-basic.lisp +++ b/tests/test-basic.lisp @@ -18,206 +18,222 @@ (in-package #:clsql-tests) + (setq *rt-basic* '( (deftest :basic/type/1 - (let ((results '())) - (dolist (row (query "select * from TYPE_TABLE" :result-types :auto) - results) - (destructuring-bind (int float str) row - (push (list (integerp int) - (typep float 'double-float) - (stringp str)) - results)))) + (with-dataset *ds-basic* + (let ((results '())) + (dolist (row (query "select * from TYPE_TABLE" :result-types :auto) + results) + (destructuring-bind (int float str) row + (push (list (integerp int) + (typep float 'double-float) + (stringp str)) + results))))) ((t t t) (t t t) (t t t) (t t t) (t t t) (t t t) (t t t) (t t t) (t t t) (t t t) (t t t))) - (deftest :basic/type/2 - (let ((results '())) - (dolist (row (query "select * from TYPE_TABLE" :result-types :auto) - results) - (destructuring-bind (int float str) row - (setq results - (cons (list (double-float-equal - (transform-float-1 int) - float) - (double-float-equal - (parse-double str) - float)) - results)))) - results) - ((t t) (t t) (t t) (t t) (t t) (t t) (t t) (t t) (t t) (t t) (t t))) - - (deftest :basic/select/1 - (let ((rows (query "select * from TYPE_TABLE" :result-types :auto))) - (values - (length rows) - (length (car rows)))) + (deftest :basic/type/2 + (with-dataset *ds-basic* + (let ((results '())) + (dolist (row (query "select * from TYPE_TABLE" :result-types :auto) + results) + (destructuring-bind (int float str) row + (setq results + (cons (list (double-float-equal + (transform-float-1 int) + float) + (double-float-equal + (parse-double str) + float)) + results)))) + results)) + ((t t) (t t) (t t) (t t) (t t) (t t) (t t) (t t) (t t) (t t) (t t))) + + (deftest :basic/select/1 + (with-dataset *ds-basic* + (let ((rows (query "select * from TYPE_TABLE" :result-types :auto))) + (values + (length rows) + (length (car rows))))) 11 3) (deftest :BASIC/SELECT/2 - (let ((results '())) - (dolist (row (query "select * from TYPE_TABLE" :result-types nil) - results) - (destructuring-bind (int float str) row - (push (list (stringp int) - (stringp float) - (stringp str)) - results)))) + (with-dataset *ds-basic* + (let ((results '())) + (dolist (row (query "select * from TYPE_TABLE" :result-types nil) + results) + (destructuring-bind (int float str) row + (push (list (stringp int) + (stringp float) + (stringp str)) + results))))) ((t t t) (t t t) (t t t) (t t t) (t t t) (t t t) (t t t) (t t t) (t t t) (t t t) (t t t))) (deftest :basic/select/3 - (let ((results '())) - (dolist (row (query "select * from TYPE_TABLE" :result-types nil) - results) - (destructuring-bind (int float str) row - (push (list (double-float-equal - (transform-float-1 (parse-integer int)) - (parse-double float)) - (double-float-equal - (parse-double str) - (parse-double float))) - results)))) + (with-dataset *ds-basic* + (let ((results '())) + (dolist (row (query "select * from TYPE_TABLE" :result-types nil) + results) + (destructuring-bind (int float str) row + (push (list (double-float-equal + (transform-float-1 (parse-integer int)) + (parse-double float)) + (double-float-equal + (parse-double str) + (parse-double float))) + results))))) ((t t) (t t) (t t) (t t) (t t) (t t) (t t) (t t) (t t) (t t) (t t))) (deftest :basic/map/1 - (let ((results '()) - (rows (map-query 'vector #'identity "select * from TYPE_TABLE" - :result-types nil))) - (declare (type (simple-array list (*)) rows)) - (dotimes (i (length rows) results) - (push - (list - (listp (aref rows i)) - (length (aref rows i)) - (eql (- i 5) - (parse-integer (first (aref rows i)) - :junk-allowed nil)) - (double-float-equal - (transform-float-1 (parse-integer (first (aref rows i)))) - (parse-double (second (aref rows i))))) - results))) + (with-dataset *ds-basic* + (let ((results '()) + (rows (map-query 'vector #'identity "select * from TYPE_TABLE" + :result-types nil))) + (declare (type (simple-array list (*)) rows)) + (dotimes (i (length rows) results) + (push + (list + (listp (aref rows i)) + (length (aref rows i)) + (eql (- i 5) + (parse-integer (first (aref rows i)) + :junk-allowed nil)) + (double-float-equal + (transform-float-1 (parse-integer (first (aref rows i)))) + (parse-double (second (aref rows i))))) + results)))) ((t 3 t t) (t 3 t t) (t 3 t t) (t 3 t t) (t 3 t t) (t 3 t t) (t 3 t t) (t 3 t t) (t 3 t t) (t 3 t t) (t 3 t t))) (deftest :basic/map/2 - (let ((results '()) - (rows (map-query 'list #'identity "select * from TYPE_TABLE" - :result-types nil))) - (dotimes (i (length rows) results) - (push - (list - (listp (nth i rows)) - (length (nth i rows)) - (eql (- i 5) - (parse-integer (first (nth i rows)) - :junk-allowed nil)) - (double-float-equal - (transform-float-1 (parse-integer (first (nth i rows)))) - (parse-double (second (nth i rows))))) - results))) + (with-dataset *ds-basic* + (let ((results '()) + (rows (map-query 'list #'identity "select * from TYPE_TABLE" + :result-types nil))) + (dotimes (i (length rows) results) + (push + (list + (listp (nth i rows)) + (length (nth i rows)) + (eql (- i 5) + (parse-integer (first (nth i rows)) + :junk-allowed nil)) + (double-float-equal + (transform-float-1 (parse-integer (first (nth i rows)))) + (parse-double (second (nth i rows))))) + results)))) ((t 3 t t) (t 3 t t) (t 3 t t) (t 3 t t) (t 3 t t) (t 3 t t) (t 3 t t) (t 3 t t) (t 3 t t) (t 3 t t) (t 3 t t))) (deftest :basic/map/3 - (let ((results '()) - (rows (map-query 'list #'identity "select * from TYPE_TABLE" - :result-types :auto))) - (dotimes (i (length rows) results) - (push - (list - (listp (nth i rows)) - (length (nth i rows)) - (eql (- i 5) - (first (nth i rows))) - (double-float-equal - (transform-float-1 (first (nth i rows))) - (second (nth i rows)))) - results))) + (with-dataset *ds-basic* + (let ((results '()) + (rows (map-query 'list #'identity "select * from TYPE_TABLE" + :result-types :auto))) + (dotimes (i (length rows) results) + (push + (list + (listp (nth i rows)) + (length (nth i rows)) + (eql (- i 5) + (first (nth i rows))) + (double-float-equal + (transform-float-1 (first (nth i rows))) + (second (nth i rows)))) + results)))) ((t 3 t t) (t 3 t t) (t 3 t t) (t 3 t t) (t 3 t t) (t 3 t t) (t 3 t t) (t 3 t t) (t 3 t t) (t 3 t t) (t 3 t t))) ;; confirm that a query on a single element returns a list of one element (deftest :basic/map/4 - (let ((rows (map-query 'list #'identity "select t_int from TYPE_TABLE" - :result-types nil))) - (values - (consp (first rows)) - (length (first rows)))) + (with-dataset *ds-basic* + (let ((rows (map-query 'list #'identity "select t_int from TYPE_TABLE" + :result-types nil))) + (values + (consp (first rows)) + (length (first rows))))) t 1) (deftest :basic/do/1 - (let ((results '())) - (do-query ((int float str) "select * from TYPE_TABLE" :result-types nil) - (let ((int-number (parse-integer int))) - (setq results - (cons (list (double-float-equal (transform-float-1 - int-number) - (parse-double float)) - (double-float-equal (parse-double str) - (parse-double float))) - results)))) - results) + (with-dataset *ds-basic* + (let ((results '())) + (do-query ((int float str) "select * from TYPE_TABLE" :result-types nil) + (let ((int-number (parse-integer int))) + (setq results + (cons (list (double-float-equal (transform-float-1 + int-number) + (parse-double float)) + (double-float-equal (parse-double str) + (parse-double float))) + results)))) + results)) ((t t) (t t) (t t) (t t) (t t) (t t) (t t) (t t) (t t) (t t) (t t))) (deftest :basic/do/2 - (let ((results '())) - (do-query ((int float str) "select * from TYPE_TABLE" :result-types :auto) - (setq results - (cons - (list (double-float-equal - (transform-float-1 int) - float) - (double-float-equal - (parse-double str) - float)) - results))) - results) + (with-dataset *ds-basic* + (let ((results '())) + (do-query ((int float str) "select * from TYPE_TABLE" :result-types :auto) + (setq results + (cons + (list (double-float-equal + (transform-float-1 int) + float) + (double-float-equal + (parse-double str) + float)) + results))) + results)) ((t t) (t t) (t t) (t t) (t t) (t t) (t t) (t t) (t t) (t t) (t t))) (deftest :basic/bigint/1 - (let ((results '())) - (dolist (row (query "select * from TYPE_BIGINT" :result-types :auto) - results) - (destructuring-bind (int bigint) row - (push (list (integerp int) - (if (and (eq :odbc *test-database-type*) - (eq :postgresql *test-database-underlying-type*)) - ;; ODBC/Postgresql may return returns bigints as strings or integer - ;; depending upon the platform - t - (integerp bigint))) - results)))) + (with-dataset *ds-bigint* + (let ((results '())) + (dolist (row (query "select * from TYPE_BIGINT" :result-types :auto) + results) + (destructuring-bind (int bigint) row + (push (list (integerp int) + (if (and (eq :odbc *test-database-type*) + (eq :postgresql *test-database-underlying-type*)) + ;; ODBC/Postgresql may return returns bigints as strings or integer + ;; depending upon the platform + t + (integerp bigint))) + results))))) ((t t) (t t) (t t) (t t) (t t) (t t) (t t) (t t) (t t) (t t) (t t))) )) -(defun test-basic-initialize () - (ignore-errors - (clsql:execute-command "DROP TABLE TYPE_TABLE") - (clsql:execute-command "DROP TABLE TYPE_BIGINT")) - - (clsql:execute-command - "CREATE TABLE TYPE_TABLE (t_int integer, t_float double precision, t_str VARCHAR(30))") - - (if (clsql-sys:db-type-has-bigint? *test-database-type*) - (clsql:execute-command "CREATE TABLE TYPE_BIGINT (t_int integer, t_bigint BIGINT)") - (clsql:execute-command "CREATE TABLE TYPE_BIGINT (t_int integer)")) - - (dotimes (i 11) - (let* ((test-int (- i 5)) - (test-flt (transform-float-1 test-int))) - (clsql:execute-command - (format nil "INSERT INTO TYPE_TABLE VALUES (~a,~a,'~a')" - test-int - (clsql-sys:number-to-sql-string test-flt) - (clsql-sys:number-to-sql-string test-flt) - )) - (when (clsql-sys:db-type-has-bigint? *test-database-type*) - (clsql:execute-command - (format nil "INSERT INTO TYPE_BIGINT VALUES (~a,~a)" - test-int - (transform-bigint-1 test-int) - )))))) +(def-dataset *ds-basic* + (:setup (lambda () + (ignore-errors + (clsql:execute-command "DROP TABLE TYPE_TABLE") + (clsql:execute-command "DROP TABLE TYPE_BIGINT")) + + (clsql:execute-command + "CREATE TABLE TYPE_TABLE (t_int integer, t_float double precision, t_str VARCHAR(30))") + + (dotimes (i 11) + (let* ((test-int (- i 5)) + (test-flt (transform-float-1 test-int))) + (clsql:execute-command + (format nil "INSERT INTO TYPE_TABLE VALUES (~a,~a,'~a')" + test-int + (clsql-sys:number-to-sql-string test-flt) + (clsql-sys:number-to-sql-string test-flt) + )))))) + (:cleanup "DROP TABLE TYPE_TABLE")) + +(def-dataset *ds-bigint* + (:setup (lambda () + (ignore-errors (clsql:execute-command "DROP TABLE TYPE_BIGINT")) + (clsql:execute-command "CREATE TABLE TYPE_BIGINT (T_INT integer, T_BIGINT BIGINT)") + (dotimes (i 11) + (clsql:execute-command + (format nil "INSERT INTO TYPE_BIGINT VALUES (~a,~a)" + (- i 5) + (transform-bigint-1 (- i 5))))))) + (:cleanup "DROP TABLE TYPE_BIGINT")) ;;;; Testing functions @@ -234,9 +250,9 @@ (defun double-float-equal (a b) (if (zerop a) (if (zerop b) - t - nil) + t + nil) (let ((diff (abs (/ (- a b) a)))) - (if (> diff (* 10 double-float-epsilon)) - nil - t)))) + (if (> diff (* 10 double-float-epsilon)) + nil + t)))) diff --git a/tests/test-fddl.lisp b/tests/test-fddl.lisp index e3dc1b2..cb932d0 100644 --- a/tests/test-fddl.lisp +++ b/tests/test-fddl.lisp @@ -19,44 +19,52 @@ #.(clsql:locally-enable-sql-reader-syntax) +(def-dataset *ds-fddl* + (:setup ("CREATE TABLE ALPHA (A integer, B integer, C varchar (30), d date, f float)" + "CREATE TABLE BRAVO (jack integer, jill integer)")) + (:sqldata "ALPHA" "A,B,C,d,f" + "1,1,'asdf','2010-01-01',3.14" + "2,1,'blarg','2012-12-21',0.1") + (:cleanup "DROP TABLE ALPHA" "DROP TABLE BRAVO")) + (setq *rt-fddl* '( ;; list current tables (deftest :fddl/table/1 - (sort (mapcar #'string-downcase - (clsql:list-tables :owner *test-database-user*)) - #'string<) - ("addr" "big" "company" "ea_join" "employee" "node" "setting" - "subloc" "theme" "type_bigint" "type_table" "user")) + (with-dataset *ds-fddl* + (sort (mapcar #'string-downcase + (clsql:list-tables :owner *test-database-user*)) + #'string<)) + ("alpha" "bravo")) ;; create a table, test for its existence, drop it and test again (deftest :fddl/table/2 (progn (clsql:create-table [foo] - '(([id] integer) - ([height] float) - ([name] (string 24)) - ([comments] longchar))) - (values - (clsql:table-exists-p [foo] :owner *test-database-user*) - (progn - (clsql:drop-table [foo] :if-does-not-exist :ignore) - (clsql:table-exists-p [foo] :owner *test-database-user*)))) + '(([id] integer) + ([height] float) + ([name] (string 24)) + ([comments] longchar))) + (values + (clsql:table-exists-p [foo] :owner *test-database-user*) + (progn + (clsql:drop-table [foo] :if-does-not-exist :ignore) + (clsql:table-exists-p [foo] :owner *test-database-user*)))) t nil) ;; create a table, list its attributes and drop it (deftest :fddl/table/3 (apply #'values - (progn (clsql:create-table [foo] - '(([id] integer) - ([height] float) - ([name] (char 255)) - ([comments] longchar))) - (prog1 - (sort (mapcar #'string-downcase - (clsql:list-attributes [foo])) - #'string<) - (clsql:drop-table [foo] :if-does-not-exist :ignore)))) + (progn (clsql:create-table [foo] + '(([id] integer) + ([height] float) + ([name] (char 255)) + ([comments] longchar))) + (prog1 + (sort (mapcar #'string-downcase + (clsql:list-attributes [foo])) + #'string<) + (clsql:drop-table [foo] :if-does-not-exist :ignore)))) "comments" "height" "id" "name") (deftest :fddl/table/4 @@ -72,11 +80,11 @@ (deftest :fddl/table/5 (prog1 - (progn - (clsql:create-table "MyMixedCase" '(([a] integer))) - (clsql:execute-command "insert into \"MyMixedCase\" values (5)") - (clsql:insert-records :into "MyMixedCase" :values '(6)) - (clsql:select [a] :from "MyMixedCase" :order-by '((a :asc)))) + (progn + (clsql:create-table "MyMixedCase" '(([a] integer))) + (clsql:execute-command "insert into \"MyMixedCase\" values (5)") + (clsql:insert-records :into "MyMixedCase" :values '(6)) + (clsql:select [a] :from "MyMixedCase" :order-by '((a :asc)))) (clsql:drop-table "MyMixedCase")) ((5) (6))) @@ -85,17 +93,17 @@ (clsql:table-exists-p [foo]) (progn (let ((*backend-warning-behavior* - (if (member *test-database-type* - '(:postgresql :postgresql-socket)) - :ignore - :warn))) - (case *test-database-underlying-type* - (:mssql (clsql:create-table [foo] - '(([bar] integer :not-null :primary-key) - ([baz] string :not-null :unique)))) - (t (clsql:create-table [foo] - '(([bar] integer :not-null :unique :primary-key) - ([baz] string :not-null :unique)))))) + (if (member *test-database-type* + '(:postgresql :postgresql-socket)) + :ignore + :warn))) + (case *test-database-underlying-type* + (:mssql (clsql:create-table [foo] + '(([bar] integer :not-null :primary-key) + ([baz] string :not-null :unique)))) + (t (clsql:create-table [foo] + '(([bar] integer :not-null :unique :primary-key) + ([baz] string :not-null :unique)))))) (clsql:table-exists-p [foo])) (progn (clsql:drop-table [foo]) @@ -107,14 +115,14 @@ (clsql:table-exists-p [foo]) (progn (let ((*backend-warning-behavior* - (if (member *test-database-type* - '(:postgresql :postgresql-socket)) - :ignore - :warn))) - (clsql:create-table [foo] '(([bar] integer :not-null) - ([baz] string :not-null)) - :constraints '("UNIQUE (bar,baz)" - "PRIMARY KEY (bar)"))) + (if (member *test-database-type* + '(:postgresql :postgresql-socket)) + :ignore + :warn))) + (clsql:create-table [foo] '(([bar] integer :not-null) + ([baz] string :not-null)) + :constraints '("UNIQUE (bar,baz)" + "PRIMARY KEY (bar)"))) (clsql:table-exists-p [foo])) (progn (clsql:drop-table [foo]) @@ -123,143 +131,158 @@ (deftest :fddl/attributes/1 (apply #'values - (sort - (mapcar #'string-downcase - (clsql:list-attributes [employee] - :owner *test-database-user*)) - #'string<)) - "bd_utime" "birthday" "ecompanyid" "email" "emplid" "first_name" "groupid" "height" - "last_name" "managerid" "married") + (with-dataset *ds-fddl* + (sort + (mapcar #'string-downcase + (clsql:list-attributes [alpha] :owner *test-database-user*)) + #'string<))) + "a" "b" "c" "d" "f") (deftest :fddl/attributes/2 - (apply #'values - (sort - (mapcar #'(lambda (a) (string-downcase (car a))) - (clsql:list-attribute-types [employee] - :owner *test-database-user*)) - #'string<)) - "bd_utime" "birthday" "ecompanyid" "email" "emplid" "first_name" "groupid" "height" - "last_name" "managerid" "married") + (with-dataset *ds-fddl* + (apply #'values + (sort + (mapcar #'(lambda (a) (string-downcase (car a))) + (clsql:list-attribute-types [alpha] + :owner *test-database-user*)) + #'string<))) + "a" "b" "c" "d" "f") ;; Attribute types are vendor specific so need to test a range (deftest :fddl/attributes/3 - (and (member (clsql:attribute-type [emplid] [employee]) '(:int :integer :int4 :number)) t) + (with-dataset *ds-fddl* + (and (member (clsql:attribute-type [a] [alpha]) '(:int :integer :int4 :number)) t)) t) (deftest :fddl/attributes/4 - (multiple-value-bind (type length scale nullable) - (clsql:attribute-type [first-name] [employee]) - (values (clsql-sys:in type :varchar :varchar2) length scale nullable)) + (with-dataset *ds-fddl* + (multiple-value-bind (type length scale nullable) + (clsql:attribute-type [c] [alpha]) + (values (clsql-sys:in type :varchar :varchar2) length scale nullable))) t 30 nil 1) (deftest :fddl/attributes/5 - (and (member (clsql:attribute-type [birthday] [employee]) '(:datetime :timestamp :date)) t) + (with-dataset *ds-fddl* + (and (member (clsql:attribute-type [d] [alpha]) '(:datetime :timestamp :date)) t)) t) (deftest :fddl/attributes/6 - (and (member (clsql:attribute-type [height] [employee]) '(:float :float8 :number)) t) + (with-dataset *ds-fddl* + (and (member (clsql:attribute-type [f] [alpha]) '(:float :float8 :number)) t)) t) (deftest :fddl/attributes/7 - (and (member (clsql:attribute-type [bd_utime] [employee]) '(:bigint :int8 :char)) t) + (with-dataset *ds-bigint* + (and (member (clsql:attribute-type [t_bigint] [TYPE_BIGINT]) '(:bigint :int8)) t)) t) ;; create a view, test for existence, drop it and test again (deftest :fddl/view/1 - (progn (clsql:create-view [lenins-group] - :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*)))) + (with-dataset *ds-fddl* + (progn (clsql:create-view [v1] + :as [select [a] [b] [c] + :from [alpha] + :where [= [a] 1]]) + (values + (clsql:view-exists-p [v1] :owner *test-database-user*) + (progn + (clsql:drop-view [v1] :if-does-not-exist :ignore) + (clsql:view-exists-p [v1] :owner *test-database-user*))))) t nil) ;; create a view, list its attributes and drop it -(when (clsql-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"))) +(deftest :fddl/view/2 + (with-dataset *ds-fddl* + (progn (clsql:create-view [v1] + :as [select [a] [b] [c] + :from [alpha] + :where [= [a] 1]]) + (unwind-protect + (sort (mapcar #'string-downcase + (clsql:list-attributes [v1])) + #'string<) + (clsql:drop-view [v1] :if-does-not-exist :ignore)))) + ("a" "b" "c")) ;; 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))) - nil ("Josef" "Stalin" "stalin@soviet.org")) + (with-dataset *ds-fddl* + (progn + (clsql:create-view [v1] + :as [select [a] [b] [c] + :from [alpha] + :where [= [a] 1]]) + (unwind-protect + (let ((result + (list + ;; Shouldn't exist + (clsql:select [a] [b] [c] + :from [v1] + :where [= [a] -1]) + ;; Should exist + (car (clsql:select [a] [b] [c] + :from [v1] + :where [= [a] 1]))))) + + (apply #'values result)) + (clsql:drop-view [v1] :if-does-not-exist :ignore)))) + nil (1 1 "asdf")) (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]]) - (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:drop-view [lenins-group] :if-does-not-exist :ignore) - (apply #'values result))) - nil ("Josef" "Stalin" "stalin@soviet.org")) + (with-dataset *ds-fddl* + (progn + (clsql:create-view [v1] + :column-list '([x] [y] [z]) + :as [select [a] [b] [c] + :from [alpha] + :where [= [a] 1]]) + (unwind-protect + (let ((result + (list + ;; Shouldn't exist + (clsql:select [x] [y] [z] + :from [v1] + :where [= [x] -1]) + ;; Should exist + (car (clsql:select [x] [y] [z] + :from [v1] + :where [= [x] 1]))))) + + (apply #'values result)) + (clsql:drop-view [v1] :if-does-not-exist :ignore)))) + nil (1 1 "asdf")) ;; create an index, test for existence, drop it and test again (deftest :fddl/index/1 - (progn (clsql:create-index [bar] :on [employee] :attributes - '([first-name] [last-name] [email]) :unique t) - (values - (clsql:index-exists-p [bar] :owner *test-database-user*) - (progn - (clsql:drop-index [bar] :on [employee] - :if-does-not-exist :ignore) - (clsql:index-exists-p [bar] :owner *test-database-user*)))) + (with-dataset *ds-fddl* + (progn (clsql:create-index [bar] :on [alpha] :attributes + '([a] [b] [c]) :unique t) + (values + (clsql:index-exists-p [bar] :owner *test-database-user*) + (progn + (clsql:drop-index [bar] :on [employee] + :if-does-not-exist :ignore) + (clsql:index-exists-p [bar] :owner *test-database-user*))))) t nil) ;; create indexes with names as strings, symbols and in square brackets (deftest :fddl/index/2 - (let ((names '("foo" foo [foo])) - (result '())) - (dolist (name names) - (clsql:create-index name :on [employee] :attributes '([last-name])) - (push (clsql:index-exists-p name :owner *test-database-user*) result) - (clsql:drop-index name :on [employee] :if-does-not-exist :ignore)) - (apply #'values result)) + (with-dataset *ds-fddl* + (let ((names '("foo" foo [foo])) + (result '())) + (dolist (name names) + (clsql:create-index name :on [alpha] :attributes '([a])) + (push (clsql:index-exists-p name :owner *test-database-user*) result) + (clsql:drop-index name :on [alpha] :if-does-not-exist :ignore)) + (apply #'values result))) t t t) ;; test list-indexes with keyword :ON (deftest :fddl/index/3 (progn (clsql:create-table [i3test] '(([a] (string 10)) - ([b] integer))) + ([b] integer))) (clsql:create-index [foo] :on [i3test] :attributes '([b]) :unique nil) (clsql:create-index [bar] :on [i3test] :attributes @@ -269,25 +292,25 @@ (clsql:index-exists-p [foo]) (clsql:index-exists-p [bar]) (sort - (mapcar - #'string-downcase - (clsql:list-indexes :on [i3test] :owner *test-database-user*)) - #'string-lessp) + (mapcar + #'string-downcase + (clsql:list-indexes :on [i3test] :owner *test-database-user*)) + #'string-lessp) (progn - (clsql:drop-index [bar] :on [i3test]) - (clsql:drop-index [foo] :on [i3test]) - (clsql:drop-table [i3test]) - t))) + (clsql:drop-index [bar] :on [i3test]) + (clsql:drop-index [foo] :on [i3test]) + (clsql:drop-table [i3test]) + t))) t t t ("bar" "foo") t) ;; create an sequence, test for existence, drop it and test again (deftest :fddl/sequence/1 (progn (clsql:create-sequence [foo]) - (values - (clsql:sequence-exists-p [foo] :owner *test-database-user*) - (progn - (clsql:drop-sequence [foo] :if-does-not-exist :ignore) - (clsql:sequence-exists-p [foo] :owner *test-database-user*)))) + (values + (clsql:sequence-exists-p [foo] :owner *test-database-user*) + (progn + (clsql:drop-sequence [foo] :if-does-not-exist :ignore) + (clsql:sequence-exists-p [foo] :owner *test-database-user*)))) t nil) ;; create and increment a sequence @@ -296,8 +319,8 @@ (clsql:create-sequence [foo]) (setf val1 (clsql:sequence-next [foo])) (prog1 - (< val1 (clsql:sequence-next [foo])) - (clsql:drop-sequence [foo] :if-does-not-exist :ignore))) + (< val1 (clsql:sequence-next [foo])) + (clsql:drop-sequence [foo] :if-does-not-exist :ignore))) t) ;; explicitly set the value of a sequence @@ -306,60 +329,43 @@ (clsql:create-sequence [foo]) (clsql:set-sequence-position [foo] 5) (prog1 - (clsql:sequence-next [foo]) - (clsql:drop-sequence [foo] :if-does-not-exist :ignore))) + (clsql:sequence-next [foo]) + (clsql:drop-sequence [foo] :if-does-not-exist :ignore))) 6) -(deftest :fddl/big/1 - (let ((rows (clsql:select [*] :from [big] :order-by [i] :field-names nil))) - (values - (length rows) - (do ((i 0 (1+ i)) - (max (expt 2 60)) - (rest rows (cdr rest))) - ((= i (length rows)) t) - (let ((index (1+ i)) - (int (first (car rest))) - (bigint (second (car rest)))) - (when (and (or (eq *test-database-type* :oracle) - (and (eq *test-database-type* :odbc) - (eq *test-database-underlying-type* :postgresql))) - (stringp bigint)) - (setf bigint (parse-integer bigint))) - (unless (and (eql int index) - (eql bigint (truncate max index))) - (return nil)))))) - 555 t) + (deftest :fddl/owner/1 - (and - ;; user tables are an improper subset of all tables - (= (length (intersection (clsql:list-tables :owner nil) - (clsql:list-tables :owner :all) - :test #'string=)) - (length (clsql:list-tables :owner nil))) - ;; user tables are a proper subset of all tables - (> (length (clsql:list-tables :owner :all)) - (length (clsql:list-tables :owner nil)))) + (with-dataset *ds-fddl* + (and + ;; user tables are an improper subset of all tables + (= (length (intersection (clsql:list-tables :owner nil) + (clsql:list-tables :owner :all) + :test #'string=)) + (length (clsql:list-tables :owner nil))) + ;; user tables are a proper subset of all tables + (> (length (clsql:list-tables :owner :all)) + (length (clsql:list-tables :owner nil))))) t) (deftest :fddl/cache-table-queries/1 - (list - (gethash "EMPLOYEE" (clsql-sys::attribute-cache clsql:*default-database*)) - (progn - (clsql:cache-table-queries "EMPLOYEE" :action t) - (gethash "EMPLOYEE" (clsql-sys::attribute-cache clsql:*default-database*))) - (progn - (clsql:list-attribute-types "EMPLOYEE") - (not - (null - (cadr - (gethash "EMPLOYEE" - (clsql-sys::attribute-cache clsql:*default-database*)))))) - (progn - (clsql:cache-table-queries "EMPLOYEE" :action :flush) - (gethash "EMPLOYEE" (clsql-sys::attribute-cache clsql:*default-database*)))) - (nil (t nil) t (t nil))) + (with-dataset *ds-fddl* + (list + (gethash "ALPHA" (clsql-sys::attribute-cache clsql:*default-database*)) + (progn + (clsql:cache-table-queries "ALPHA" :action t) + (gethash "ALPHA" (clsql-sys::attribute-cache clsql:*default-database*))) + (progn + (clsql:list-attribute-types "ALPHA") + (not + (null + (cadr + (gethash "ALPHA" + (clsql-sys::attribute-cache clsql:*default-database*)))))) + (progn + (clsql:cache-table-queries "ALPHA" :action :flush) + (gethash "ALPHA" (clsql-sys::attribute-cache clsql:*default-database*))))) + (nil (t nil) t (t nil))) )) diff --git a/tests/test-init.lisp b/tests/test-init.lisp index 3307198..f88fb91 100644 --- a/tests/test-init.lisp +++ b/tests/test-init.lisp @@ -291,23 +291,23 @@ (defun test-initialise-database () - (test-basic-initialize) ;; (start-sql-recording :type :both) (let ((*backend-warning-behavior* (if (member *test-database-type* '(:postgresql :postgresql-socket)) :ignore :warn))) - (clsql:create-view-from-class 'employee) - (clsql:create-view-from-class 'company) - (clsql:create-view-from-class 'address) - (clsql:create-view-from-class 'employee-address) - (clsql:create-view-from-class 'big) - (clsql:create-view-from-class 'node) - (clsql:create-view-from-class 'setting) - (clsql:create-view-from-class 'user) - (clsql:create-view-from-class 'theme) - (clsql:create-view-from-class 'location) - (clsql:create-view-from-class 'subloc)) + ;; (clsql:create-view-from-class 'employee) + ;; (clsql:create-view-from-class 'company) + ;; (clsql:create-view-from-class 'address) + ;; (clsql:create-view-from-class 'employee-address) + ;; (clsql:create-view-from-class 'big) + ;; (clsql:create-view-from-class 'node) + ;; (clsql:create-view-from-class 'setting) + ;; (clsql:create-view-from-class 'user) + ;; (clsql:create-view-from-class 'theme) + ;; (clsql:create-view-from-class 'location) + ;; (clsql:create-view-from-class 'subloc) + ) (setq *test-start-utime* (get-universal-time)) (let* ((*db-auto-sync* t) @@ -625,7 +625,7 @@ (write-report-banner "Test Suite" db-type *report-stream*) - (test-initialise-database) +; (test-initialise-database) (regression-test:rem-all-tests) (dolist (test-form test-forms) @@ -737,7 +737,7 @@ (when *default-database* (disconnect :database *default-database*)) (test-connect-to-database type (nth position (db-type-spec type (read-specs)))) - (test-initialise-database) + ;(test-initialise-database) *default-database*) (defun rl () diff --git a/tests/test-ooddl.lisp b/tests/test-ooddl.lisp index d7a1933..7aec981 100644 --- a/tests/test-ooddl.lisp +++ b/tests/test-ooddl.lisp @@ -85,6 +85,27 @@ (slot-value (employee-manager employee2) 'last-name) "Lenin") +(deftest :ooddl/big/1 + (let ((rows (clsql:select [*] :from [big] :order-by [i] :field-names nil))) + (values + (length rows) + (do ((i 0 (1+ i)) + (max (expt 2 60)) + (rest rows (cdr rest))) + ((= i (length rows)) t) + (let ((index (1+ i)) + (int (first (car rest))) + (bigint (second (car rest)))) + (when (and (or (eq *test-database-type* :oracle) + (and (eq *test-database-type* :odbc) + (eq *test-database-underlying-type* :postgresql))) + (stringp bigint)) + (setf bigint (parse-integer bigint))) + (unless (and (eql int index) + (eql bigint (truncate max index))) + (return nil)))))) + 555 t) + (deftest :ooddl/time/1 (let* ((now (clsql:get-time))) (when (member *test-database-underlying-type* '(:postgresql :postgresql-socket)) -- 2.34.1