(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
(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))))
#.(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
(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)))
(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])
(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])
(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
(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
(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
(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)))
))
projects / clsql.git / commitdiff