X-Git-Url: http://git.kpe.io/?p=clsql.git;a=blobdiff_plain;f=tests%2Ftest-fddl.lisp;h=ed25a04d2b9a65a396d5aa4b8064cd6b2b7086a0;hp=0dc053b1307210b3e005f85c26b3039091b15669;hb=d2d49ab13c98bc7a1819a0fd3968268a5567bdc3;hpb=9bbed78051e80e6ab76ae47834136035602bbbf1

diff --git a/tests/test-fddl.lisp b/tests/test-fddl.lisp
index 0dc053b..ed25a04 100644
--- a/tests/test-fddl.lisp
+++ b/tests/test-fddl.lisp
@@ -1,194 +1,306 @@
 ;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
-;;;; ======================================================================
-;;;; File:     test-fddl.lisp
-;;;; Authors:  Marcus Pearce <m.t.pearce@city.ac.uk> and Kevin Rosenberg
-;;;; Created:  30/03/2004
-;;;; Updated:  $Id$
+;;;; *************************************************************************
+;;;; FILE IDENTIFICATION
 ;;;;
-;;;; Tests for the CLSQL Functional Data Definition Language
-;;;; (FDDL).
+;;;; Name:     test-fddl.lisp
+;;;; Purpose:  Tests for the CLSQL Functional Data Definition Language
+;;;; Authors:  Marcus Pearce and Kevin M. Rosenberg
+;;;; Created:  March 2004
 ;;;;
 ;;;; 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:locally-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"))
+
+(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<))
-  "company" "employee" "type_table")
+    (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")
+    (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
-    (and (member (clsql:attribute-type [emplid] [employee]) '(:int :integer :int4)) t)
+    (with-dataset *ds-fddl*
+      (and (member (clsql:attribute-type [a] [alpha]) '(:int :integer :int4 :number)) t))
   t)
 
 (deftest :fddl/attributes/4
-    (clsql:attribute-type [first-name] [employee]) 
-  :varchar 30 nil 1)
+    (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)) 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)) t)
+    (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]
-			      :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 
-(when (clsql-base: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 
+
+  ;; create a view, list its attributes and drop it
+(deftest :fddl/view/2
+      (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"))
-  
+    (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
-    (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
-	      (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] [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)
-	(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 ) result)
+	  (clsql:drop-index name :on [alpha] :if-does-not-exist :ignore))
+	(apply #'values result)))
   t t t)
 
-;; test list-table-indexes
+;; test list-indexes with keyword :ON
 (deftest :fddl/index/3
     (progn
       (clsql:create-table [i3test] '(([a] (string 10))
@@ -201,10 +313,10 @@
        (clsql:table-exists-p [i3test])
        (clsql:index-exists-p [foo])
        (clsql:index-exists-p [bar])
-       (sort 
-	(mapcar 
+       (sort
+	(mapcar
 	 #'string-downcase
-	 (clsql:list-table-indexes [i3test] :owner *test-database-user*))
+	 (clsql:list-indexes :on [i3test]))
 	#'string-lessp)
        (progn
 	 (clsql:drop-index [bar] :on [i3test])
@@ -213,14 +325,14 @@
 	 t)))
   t t t ("bar" "foo") t)
 
-;; create an sequence, test for existence, drop it and test again 
+;; 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
@@ -229,8 +341,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
@@ -239,10 +351,103 @@
       (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/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)))
+
+  ))
 
 #.(clsql:restore-sql-reader-syntax-state)