+++ /dev/null
-;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
-;;;; ======================================================================
-;;;; File: test-fddl.lisp
-;;;; Author: Marcus Pearce <m.t.pearce@city.ac.uk>
-;;;; Created: 30/03/2004
-;;;; Updated: <04/04/2004 11:53:29 marcusp>
-;;;; ======================================================================
-;;;;
-;;;; Description ==========================================================
-;;;; ======================================================================
-;;;;
-;;;; Tests for the CLSQL-USQL Functional Data Definition Language
-;;;; (FDDL).
-;;;;
-;;;; ======================================================================
-
-(in-package :clsql-usql-tests)
-
-#.(usql:locally-enable-sql-reader-syntax)
-
-;; list current tables
-(deftest :fddl/table/1
- (apply #'values
- (sort (mapcar #'string-downcase
- (usql:list-tables :owner *test-database-user*))
- #'string>))
- "usql_object_v" "employee" "company")
-
-;; create a table, test for its existence, drop it and test again
-(deftest :fddl/table/2
- (progn (usql:create-table [foo]
- '(([id] integer)
- ([height] float)
- ([name] (string 24))
- ([comments] longchar)))
- (values
- (usql:table-exists-p [foo] :owner *test-database-user*)
- (progn
- (usql:drop-table [foo] :if-does-not-exist :ignore)
- (usql: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 (usql:create-table [foo]
- '(([id] integer)
- ([height] float)
- ([name] (char 255))
- ([comments] longchar)))
- (prog1
- (sort (mapcar #'string-downcase
- (usql:list-attributes [foo]))
- #'string<)
- (usql:drop-table [foo] :if-does-not-exist :ignore))))
- "comments" "height" "id" "name")
-
-(deftest :fddl/attributes/1
- (apply #'values
- (sort
- (mapcar #'string-downcase
- (usql:list-attributes [employee]
- :owner *test-database-user*))
- #'string<))
- "birthday" "companyid" "email" "emplid" "first_name" "groupid" "height"
- "last_name" "managerid" "married")
-
-(deftest :fddl/attributes/2
- (apply #'values
- (sort
- (mapcar #'(lambda (a) (string-downcase (car a)))
- (usql:list-attribute-types [employee]
- :owner *test-database-user*))
- #'string<))
- "birthday" "companyid" "email" "emplid" "first_name" "groupid" "height"
- "last_name" "managerid" "married")
-
-;; create a view, test for existence, drop it and test again
-(deftest :fddl/view/1
- (progn (usql: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
- (usql:view-exists-p [lenins-group] :owner *test-database-user*)
- (progn
- (usql:drop-view [lenins-group] :if-does-not-exist :ignore)
- (usql: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 (usql: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
- (usql:list-attributes [lenins-group]))
- #'string<)
- (usql: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 (usql:create-view [lenins-group]
- :as [select [first-name] [last-name] [email]
- :from [employee]
- :where [= [managerid] 1]])
- (let ((result
- (list
- ;; Shouldn't exist
- (usql:select [first-name] [last-name] [email]
- :from [lenins-group]
- :where [= [last-name] "Lenin"])
- ;; Should exist
- (car (usql:select [first-name] [last-name] [email]
- :from [lenins-group]
- :where [= [last-name] "Stalin"])))))
- (usql: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
- (if (eql *test-database-type* :sqlite)
- (values nil '(("Josef" "Stalin" "stalin@soviet.org")))
- (progn (usql: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
- (usql:select [forename] [surname] [email]
- :from [lenins-group]
- :where [= [surname] "Lenin"])
- ;; Should exist
- (car (usql:select [forename] [surname] [email]
- :from [lenins-group]
- :where [= [surname] "Stalin"])))))
- (usql:drop-view [lenins-group] :if-does-not-exist :ignore)
- (apply #'values result))))
- nil ("Josef" "Stalin" "stalin@soviet.org"))
-
-;; create an index, test for existence, drop it and test again
-(deftest :fddl/index/1
- (progn (usql:create-index [bar] :on [employee] :attributes
- '([first-name] [last-name] [email]) :unique t)
- (values
- (usql:index-exists-p [bar] :owner *test-database-user*)
- (progn
- (case *test-database-type*
- (:mysql
- (usql:drop-index [bar] :on [employee]
- :if-does-not-exist :ignore))
- (t
- (usql:drop-index [bar]:if-does-not-exist :ignore)))
- (usql:view-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)
- (usql:create-index name :on [employee] :attributes '([emplid]))
- (push (usql:index-exists-p name :owner *test-database-user*) result)
- (case *test-database-type*
- (:mysql
- (usql:drop-index name :on [employee] :if-does-not-exist :ignore))
- (t (usql:drop-index name :if-does-not-exist :ignore))))
- (apply #'values result))
- t t t)
-
-;; create an sequence, test for existence, drop it and test again
-(deftest :fddl/sequence/1
- (progn (usql:create-sequence [foo])
- (values
- (usql:sequence-exists-p [foo] :owner *test-database-user*)
- (progn
- (usql:drop-sequence [foo] :if-does-not-exist :ignore)
- (usql:sequence-exists-p [foo] :owner *test-database-user*))))
- t nil)
-
-;; create and increment a sequence
-(deftest :fddl/sequence/2
- (let ((val1 nil))
- (usql:create-sequence [foo])
- (setf val1 (usql:sequence-next [foo]))
- (prog1
- (< val1 (usql:sequence-next [foo]))
- (usql:drop-sequence [foo] :if-does-not-exist :ignore)))
- t)
-
-;; explicitly set the value of a sequence
-(deftest :fddl/sequence/3
- (progn
- (usql:create-sequence [foo])
- (usql:set-sequence-position [foo] 5)
- (prog1
- (usql:sequence-next [foo])
- (usql:drop-sequence [foo] :if-does-not-exist :ignore)))
- 6)
-
-#.(usql:restore-sql-reader-syntax-state)
\ No newline at end of file
projects / clsql.git / blobdiff