X-Git-Url: http://git.kpe.io/?p=clsql.git;a=blobdiff_plain;f=tests%2Ftest-fddl.lisp;h=83eada9f1074e699b6e584d90360be9e884be957;hp=918c56f878ca0b964f701527437c82512274df6c;hb=151c009059521769a44ec35dfdceb86d5373af99;hpb=70227e5f0b76bb649fc6c1a478d7374953fd815b

diff --git a/tests/test-fddl.lisp b/tests/test-fddl.lisp
index 918c56f..83eada9 100644
--- a/tests/test-fddl.lisp
+++ b/tests/test-fddl.lisp
@@ -1,194 +1,339 @@
 ;;;; -*- 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: $Id$
-;;;; ======================================================================
+;;;; *************************************************************************
+;;;; FILE IDENTIFICATION
 ;;;;
-;;;; Description ==========================================================
-;;;; ======================================================================
+;;;; Name:     test-fddl.lisp
+;;;; Purpose:  Tests for the CLSQL Functional Data Definition Language
+;;;; Authors:  Marcus Pearce and Kevin M. Rosenberg
+;;;; Created:  March 2004
 ;;;;
-;;;; Tests for the CLSQL Functional Data Definition Language
-;;;; (FDDL).
-;;;; 
-;;;; ======================================================================
+;;;; This file is part of CLSQL.
+;;;;
+;;;; CLSQL users are granted the rights to distribute and use this software
+;;;; as governed by the terms of the Lisp Lesser GNU Public License
+;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL.
+;;;; *************************************************************************
+
 
 (in-package #:clsql-tests)
+(clsql-sys:file-enable-sql-reader-syntax)
+
+(def-dataset *ds-fddl*
+  (:setup (lambda ()
+	    (create-table [alpha] '(([a] integer)
+				    ([c] (varchar 30))
+				    ([d] date)
+				    ([f] float)))
+	    (create-table [bravo] '(([foo] integer)
+				    ([bar] integer)))))
+  (:sqldata "ALPHA" "A,C,D,F"
+	    "1,'asdf','2010-01-01',3.14"
+	    "2,'blarg','2012-12-21',0.1"
+	    "3,'matey','1992-02-29',0.0")
+  (:cleanup "DROP TABLE ALPHA" "DROP TABLE BRAVO"))
 
-#.(clsql:locally-enable-sql-reader-syntax)
+(def-dataset *ds-fddl-parsing-oddities*
+  (:setup "CREATE TABLE ATEST (
+A varchar (32),
+B varchar(32))")
+  (:cleanup "DROP TABLE ATEST"))
 
 (setq *rt-fddl*
       '(
-      
-;; list current tables 
+
+;; list current tables
 (deftest :fddl/table/1
-    (apply #'values 
-           (sort (mapcar #'string-downcase
-                         (clsql:list-tables :owner *test-database-user*))
-                 #'string>))
-  "employee" "company" "clsql_object_v")
+    (with-dataset *ds-fddl*
+      (sort (mapcar #'string-downcase
+		    (clsql:list-tables ))
+	    #'string<))
+  ("alpha" "bravo"))
 
-;; create a table, test for its existence, drop it and test again 
+;; 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])
+	    (progn
+	      (clsql:drop-table [foo] :if-does-not-exist :ignore)
+	      (clsql:table-exists-p [foo]))))
   t nil)
 
-;; create a table, list its attributes and drop it 
+;; 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))))
+    (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))))
   "comments" "height" "id" "name")
 
+(deftest :fddl/table/4
+    (values
+     (clsql:table-exists-p "MyMixedCase")
+     (progn
+       (clsql:create-table "MyMixedCase" '(([a] integer)))
+       (clsql:table-exists-p "MyMixedCase"))
+     (progn
+       (clsql:drop-table "MyMixedCase")
+       (clsql:table-exists-p "MyMixedCase")))
+  nil t nil)
+
+(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))))
+      (clsql:drop-table "MyMixedCase"))
+  ((5) (6)))
+
+(deftest :fddl/table/6
+    (values
+     (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))))))
+       (clsql:table-exists-p [foo]))
+     (progn
+       (clsql:drop-table [foo])
+       (clsql:table-exists-p [foo])))
+  nil t nil)
+
+(deftest :fddl/table/7
+    (values
+     (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)")))
+       (clsql:table-exists-p [foo]))
+     (progn
+       (clsql:drop-table [foo])
+       (clsql:table-exists-p [foo])))
+  nil t nil)
+
 (deftest :fddl/attributes/1
     (apply #'values
-           (sort 
-            (mapcar #'string-downcase
-                    (clsql:list-attributes [employee]
-                                          :owner *test-database-user*))
-            #'string<))
-  "birthday" "companyid" "email" "emplid" "first_name" "groupid" "height"
-  "last_name" "managerid" "married")
+     (with-dataset *ds-fddl*
+       (sort
+	(mapcar #'string-downcase
+		(clsql:list-attributes [alpha] ))
+	#'string<)))
+  "a" "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<))
-  "birthday" "companyid" "email" "emplid" "first_name" "groupid" "height"
-  "last_name" "managerid" "married")
-
-;; create a view, test for existence, drop it and test again 
+    (with-dataset *ds-fddl*
+      (apply #'values
+	     (sort
+	      (mapcar #'(lambda (a) (string-downcase (car a)))
+		      (clsql:list-attribute-types [alpha]))
+	      #'string<)))
+  "a" "c" "d" "f")
+
+;; Attribute types are vendor specific so need to test a range
+(deftest :fddl/attributes/3
+    (with-dataset *ds-fddl*
+      (and (member (clsql:attribute-type [a] [alpha]) '(:int :integer :int4 :number)) t))
+  t)
+
+(deftest :fddl/attributes/4
+    (with-dataset *ds-fddl*
+      (multiple-value-bind (type length scale nullable)
+	  (clsql:attribute-type [c] [alpha])
+	(values (clsql-sys:in type :varchar :varchar2 :nvarchar)
+                length scale nullable)))
+  t 30 nil 1)
+
+(deftest :fddl/attributes/5
+    (with-dataset *ds-fddl*
+      (and (member (clsql:attribute-type [d] [alpha])
+                   '(:datetime :timestamp :date :smalldatetime)) t))
+  t)
+
+(deftest :fddl/attributes/6
+    (with-dataset *ds-fddl*
+      (and (member (clsql:attribute-type [f] [alpha]) '(:float :float8 :number)) t))
+  t)
+
+(deftest :fddl/attributes/7
+    (with-dataset *ds-bigint*
+      (and (member (clsql:attribute-type [t_bigint] [TYPE_BIGINT]) '(:bigint :int8)) t))
+  t)
+
+(deftest :fddl/attributes/8
+    ;;this is mostly from sqlite3 sending back
+    (with-dataset *ds-fddl-parsing-oddities*
+      (values
+	(clsql-sys:in (clsql:attribute-type [a] [atest]) :varchar :varchar2)
+	(clsql-sys:in (clsql:attribute-type [b] [atest]) :varchar :varchar2)))
+  t t)
+
+
+;; 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*))))
+    (with-dataset *ds-fddl*
+      (progn (clsql:create-view [v1]
+				:as [select [a] [c] [d]
+					    :from [alpha]
+					    :where [= [a] 1]])
+	     (values
+	       (clsql:view-exists-p [v1])
+	       (progn
+		 (clsql:drop-view [v1] :if-does-not-exist :ignore)
+		 (clsql:view-exists-p [v1])))))
   t nil)
 
-;; create a view, list its attributes and drop it 
+  ;; 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 
+      (with-dataset *ds-fddl*
+	(progn (clsql:create-view [v1]
+			      :as [select [a] [c] [d]
+					  :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" "c" "d"))
+
+  ;; 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"))
-
-;; not in sqlite 
+    (with-dataset *ds-fddl*
+      (progn
+	(clsql:create-view [v1]
+			   :as [select [a] [c] [d]
+				       :from [alpha]
+				       :where [= [a] 1]])
+	(unwind-protect
+	     (let ((result
+		    (list
+		     ;; Shouldn't exist
+		     (clsql:select [a] [c]
+				   :from [v1]
+				   :where [= [a] -1])
+		     ;; Should exist
+		     (car (clsql:select [a] [c]
+					:from [v1]
+					:where [= [a] 1])))))
+
+	       (apply #'values result))
+	  (clsql:drop-view [v1] :if-does-not-exist :ignore))))
+  nil (1 "asdf"))
+
 (deftest :fddl/view/4
-    (if (eql *test-database-type* :sqlite)
-        (values nil '(("Josef" "Stalin" "stalin@soviet.org")))
-        (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"))
-
-;; create an index, test for existence, drop it and test again 
+    (with-dataset *ds-fddl*
+      (progn
+	(clsql:create-view [v1]
+			   :column-list '([x] [y] [z])
+			   :as [select [a] [c] [d]
+				       :from [alpha]
+				       :where [= [a] 1]])
+	(unwind-protect
+	     (let ((result
+		    (list
+		     (sort (mapcar #'string-downcase
+				   (clsql:list-attributes [v1]))
+			   #'string<)
+		     ;; Shouldn't exist
+		     (clsql:select [x] [y]
+				   :from [v1]
+				   :where [= [x] -1])
+		     ;; Should exist
+		     (car (clsql:select [x] [y]
+					:from [v1]
+					:where [= [x] 1])))))
+
+	       (apply #'values result))
+	  (clsql:drop-view [v1] :if-does-not-exist :ignore))))
+  ("x" "y" "z") nil (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
-              (case *test-database-type*
-                (:mysql 
-                 (clsql:drop-index [bar] :on [employee]
-                                  :if-does-not-exist :ignore))
-                (t 
-                 (clsql:drop-index [bar]:if-does-not-exist :ignore)))
-              (clsql:view-exists-p [bar] :owner *test-database-user*))))
+    (with-dataset *ds-fddl*
+      (progn (clsql:create-index [bar] :on [alpha] :attributes
+				 '([a] [c]) :unique t)
+	     (values
+	       (clsql:index-exists-p [bar] )
+	       (progn
+		 (clsql:drop-index [bar] :on [alpha]
+				   :if-does-not-exist :ignore)
+		 (clsql:index-exists-p [bar])))))
   t nil)
 
-;; create indexes with names as strings, symbols and in square brackets 
+;; 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 '([emplid]))
-        (push (clsql:index-exists-p name :owner *test-database-user*) result)
-        (case *test-database-type*
-          (:mysql 
-           (clsql:drop-index name :on [employee] :if-does-not-exist :ignore))
-          (t (clsql:drop-index name :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 ) result)
+	  (clsql:drop-index name :on [alpha] :if-does-not-exist :ignore))
+	(apply #'values result)))
   t t t)
 
-;; create an sequence, test for existence, drop it and test again 
+;; test list-indexes with keyword :ON
+(deftest :fddl/index/3
+    (progn
+      (clsql:create-table [i3test] '(([a] (string 10))
+				     ([b] integer)))
+      (clsql:create-index [foo] :on [i3test] :attributes
+       '([b]) :unique nil)
+      (clsql:create-index [bar] :on [i3test] :attributes
+       '([a]) :unique t)
+      (values
+       (clsql:table-exists-p [i3test])
+       (clsql:index-exists-p [foo])
+       (clsql:index-exists-p [bar])
+       (sort
+	(mapcar
+	 #'string-downcase
+	 (clsql:list-indexes :on [i3test]))
+	#'string-lessp)
+       (progn
+	 (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])
+	    (progn
+	      (clsql:drop-sequence [foo] :if-does-not-exist :ignore)
+	      (clsql:sequence-exists-p [foo]))))
   t nil)
 
 ;; create and increment a sequence
@@ -197,8 +342,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
@@ -207,10 +352,101 @@
       (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)
 
-))
 
-#.(clsql:restore-sql-reader-syntax-state)
+
+(deftest :fddl/owner/1
+    (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/owner/table
+    (with-dataset *ds-fddl*
+      (values
+	(clsql-sys:table-exists-p [alpha])
+	(clsql-sys:table-exists-p [alpha] :owner *test-database-user*)
+	(clsql-sys:table-exists-p [alpha] :owner *test-false-database-user*)))
+  t t nil)
+
+(deftest :fddl/owner/attributes
+    (with-dataset *ds-fddl*
+      (values
+	(length (clsql-sys:list-attributes [alpha]))
+	(length (clsql-sys:list-attributes [alpha] :owner *test-database-user*))
+	(length (clsql-sys:list-attributes [alpha] :owner *test-false-database-user*))))
+  4 4 0)
+
+(deftest :fddl/owner/attribute-types
+    (with-dataset *ds-fddl*
+      (values
+	(length (clsql:list-attribute-types [alpha]))
+	(length (clsql:list-attribute-types [alpha] :owner *test-database-user*))
+	(length (clsql:list-attribute-types [alpha] :owner *test-false-database-user*))))
+  4 4 0)
+
+(deftest :fddl/owner/index
+    (with-dataset *ds-fddl*
+      (progn (clsql:create-index [bar] :on [alpha]
+				 :attributes '([a] [c]))
+	     (values
+	       (clsql:index-exists-p [bar] )
+	       (clsql:index-exists-p [bar] :owner *test-database-user*)
+	       (clsql:index-exists-p [bar] :owner *test-false-database-user*)
+
+	       (length (clsql-sys:list-indexes :on [alpha]))
+	       (length (clsql-sys:list-indexes :on [alpha] :owner *test-database-user*))
+	       (length (clsql-sys:list-indexes :on [alpha] :owner *test-false-database-user*))
+	       (progn
+		 (clsql:drop-index [bar] :on [alpha]
+				   :if-does-not-exist :ignore)
+		 (clsql:index-exists-p [bar] :owner *test-database-user*))
+	       (clsql:index-exists-p [bar] ))))
+  t t nil
+  1 1 0
+  nil nil)
+
+(deftest :fddl/owner/sequence
+    (progn (clsql:create-sequence [foo])
+	   (values
+	    (clsql:sequence-exists-p [foo])
+	    (clsql:sequence-exists-p [foo] :owner *test-database-user*)
+	    (clsql:sequence-exists-p [foo] :owner *test-false-database-user*)
+
+	    (progn
+	      (clsql:drop-sequence [foo] :if-does-not-exist :ignore)
+	      (clsql:sequence-exists-p [foo] ))))
+  t t nil nil)
+
+
+
+(deftest :fddl/cache-table-queries/1
+    (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)))
+
+  ))