Merge commit 'origin/master' into development

diff --git a/db-sqlite3/sqlite3-sql.lisp b/db-sqlite3/sqlite3-sql.lisp
index 90f08120d2895898719235cc85b2e262fc824395..1ba6b0ba68649deee35d6a367d1b9bc826095f08 100644 (file)
--- a/db-sqlite3/sqlite3-sql.lisp
+++ b/db-sqlite3/sqlite3-sql.lisp
@@ -281,14 +281,16 @@
                                     (database sqlite3-database)
                                     &key (owner nil))
   (declare (ignore owner))
+  
   (loop for field-info in (sqlite3-table-info table database)
       when (string= attribute (second field-info))
       return
         (let* ((raw-type (third field-info))
                (start-length (position #\( raw-type))
-               (type (if start-length
-                         (subseq raw-type 0 start-length)
-                       raw-type))
+               (type (string-trim '(#\space #\tab #\newline)
+                                 (if start-length
+                                     (subseq raw-type 0 start-length)
+                                     raw-type)))
                (length (if start-length
                            (parse-integer (subseq raw-type (1+ start-length))
                                           :junk-allowed t)

diff --git a/sql/expressions.lisp b/sql/expressions.lisp
index 746ed001ee608232be7f24e6f78d9591b62ac4bc..770bf379a69c1e74ecd9a51e0204d81107e2e6db 100644 (file)
--- a/sql/expressions.lisp
+++ b/sql/expressions.lisp
@@ -242,19 +242,39 @@
 ;; should do arity checking of subexpressions
 
 (defmethod output-sql ((expr sql-relational-exp) database)
-  (with-slots (operator sub-expressions)
-    expr
-    (let ((subs (if (consp (car sub-expressions))
-                    (car sub-expressions)
-                    sub-expressions)))
-      (write-char #\( *sql-stream*)
-      (do ((sub subs (cdr sub)))
-          ((null (cdr sub)) (output-sql (car sub) database))
-        (output-sql (car sub) database)
-        (write-char #\Space *sql-stream*)
-        (output-sql operator database)
-        (write-char #\Space *sql-stream*))
-      (write-char #\) *sql-stream*)))
+  (with-slots (operator sub-expressions) expr
+     ;; we do this as two runs so as not to emit confusing superflous parentheses
+     ;; The first loop renders all the child outputs so that we can skip anding with
+     ;; empty output (which causes sql errors)
+     ;; the next loop simply emits each sub-expression with the appropriate number of
+     ;; parens and operators
+     (flet ((trim (sub)
+             (string-trim '(#\space #\newline #\return #\tab
+                             ;; sbcl, allegrocl, and clisp use #\no-break_space
+                             ;; lispworks uses #\no-break-space
+                             #-lispworks #\no-break_space
+                             #+lispworks #\no-break-space
+                             )
+                          (with-output-to-string (*sql-stream*)
+                            (output-sql sub database)))))
+       (let ((str-subs (loop for sub in sub-expressions
+                            for str-sub = (trim sub)
+                          when (and str-sub (> (length str-sub) 0))
+                            collect str-sub)))
+        (case (length str-subs)
+          (0 nil)
+          (1 (write-string (first str-subs) *sql-stream*))
+          (t
+             (write-char #\( *sql-stream*)
+             (write-string (first str-subs) *sql-stream*)
+             (loop for str-sub in (rest str-subs)
+                   do
+                (write-char #\Space *sql-stream*)
+                (output-sql operator database)
+                (write-char #\Space *sql-stream*)
+                (write-string str-sub *sql-stream*))
+             (write-char #\) *sql-stream*))
+          ))))
   t)
 
 (defclass sql-upcase-like (sql-relational-exp)

diff --git a/tests/benchmarks.lisp b/tests/benchmarks.lisp
index 66dfb3e75934e2d859691627f34e2990b8eaaa63..16e3e78f8b34cdc2ccc6f0db411302b09ace9654 100644 (file)
--- a/tests/benchmarks.lisp
+++ b/tests/benchmarks.lisp
@@ -42,7 +42,8 @@
 
 (defun do-benchmarks-for-backend (db-type spec count)
   (test-connect-to-database db-type spec)
-  (write-report-banner "Benchmarks" db-type *report-stream*)
+  (write-report-banner "Benchmarks" db-type *report-stream*
+                      (database-name-from-spec spec db-type))
 
   (create-view-from-class 'bench)
   (benchmark-init)

diff --git a/tests/datasets.lisp b/tests/datasets.lisp
index 114deaccccafe2a0becbba14dbe05d06515c4946..0d60e97022abfae8cfdcdfa7ffb66fdf97f569a3 100644 (file)
--- a/tests/datasets.lisp
+++ b/tests/datasets.lisp
@@ -20,7 +20,7 @@ should we debug (T) or just print and quit.")
   (when (and *dataset-debug-on-error*
             *debugger-hook*)
     (invoke-debugger e))
-  (print e *error-output*)
+  (princ e *error-output*)
   (throw 'quit-dataset e))
 
 (defmacro def-dataset (name &body body)
@@ -43,7 +43,10 @@ should we debug (T) or just print and quit.")
              (retry-dataset-init ()
                :report ,(format nil "Retry dataset('~a) init: (with any dataset changes)"
                                (symbol-name name))
-               (%dataset-init ,name)))
+               (%dataset-init ,name))
+             (skip-this-test ()
+               :report "FAIL and run the next test"
+               (throw 'quit-dataset :data-set-failure)))
            ,@body)
        (%dataset-cleanup ,name))))
 

diff --git a/tests/test-fddl.lisp b/tests/test-fddl.lisp
index 446c2f24078b3b6ffb033d3a005ee4740d081d95..a1044045a2b2035f51e16370081379def3a11042 100644 (file)
--- a/tests/test-fddl.lisp
+++ b/tests/test-fddl.lisp
@@ -20,13 +20,25 @@
 #.(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")
+  (: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*
       '(
 
@@ -34,7 +46,7 @@
 (deftest :fddl/table/1
     (with-dataset *ds-fddl*
       (sort (mapcar #'string-downcase
-                   (clsql:list-tables :owner *test-database-user*))
+                   (clsql:list-tables ))
            #'string<))
   ("alpha" "bravo"))
 
@@ -46,10 +58,10 @@
                                 ([name] (string 24))
                                 ([comments] longchar)))
           (values
-           (clsql:table-exists-p [foo] :owner *test-database-user*)
+           (clsql:table-exists-p [foo])
            (progn
              (clsql:drop-table [foo] :if-does-not-exist :ignore)
-             (clsql:table-exists-p [foo] :owner *test-database-user*))))
+             (clsql:table-exists-p [foo]))))
   t nil)
 
 ;; create a table, list its attributes and drop it
@@ -134,19 +146,18 @@
      (with-dataset *ds-fddl*
        (sort
        (mapcar #'string-downcase
-               (clsql:list-attributes [alpha] :owner *test-database-user*))
+               (clsql:list-attributes [alpha] ))
        #'string<)))
-  "a" "b" "c" "d" "f")
+  "a" "c" "d" "f")
 
 (deftest :fddl/attributes/2
     (with-dataset *ds-fddl*
       (apply #'values
             (sort
              (mapcar #'(lambda (a) (string-downcase (car a)))
-                     (clsql:list-attribute-types [alpha]
-                                                 :owner *test-database-user*))
+                     (clsql:list-attribute-types [alpha]))
              #'string<)))
-  "a" "b" "c" "d" "f")
+  "a" "c" "d" "f")
 
 ;; Attribute types are vendor specific so need to test a range
 (deftest :fddl/attributes/3
@@ -176,26 +187,34 @@
       (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
     (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*)))))
+      (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
 (deftest :fddl/view/2
       (with-dataset *ds-fddl*
        (progn (clsql:create-view [v1]
-                             :as [select [a] [b] [c]
+                             :as [select [a] [c] [d]
                                          :from [alpha]
                                          :where [= [a] 1]])
             (unwind-protect
@@ -203,67 +222,70 @@
                                (clsql:list-attributes [v1]))
                        #'string<)
               (clsql:drop-view [v1] :if-does-not-exist :ignore))))
-    ("a" "b" "c"))
+    ("a" "c" "d"))
 
   ;; create a view, select stuff from it and drop it
 (deftest :fddl/view/3
     (with-dataset *ds-fddl*
       (progn
        (clsql:create-view [v1]
-                          :as [select [a] [b] [c]
+                          :as [select [a] [c] [d]
                                       :from [alpha]
                                       :where [= [a] 1]])
        (unwind-protect
             (let ((result
                    (list
                     ;; Shouldn't exist
-                    (clsql:select [a] [b] [c]
+                    (clsql:select [a] [c] 
                                   :from [v1]
                                   :where [= [a] -1])
                     ;; Should exist
-                    (car (clsql:select [a] [b] [c]
+                    (car (clsql:select [a] [c]
                                        :from [v1]
                                        :where [= [a] 1])))))
 
               (apply #'values result))
          (clsql:drop-view [v1] :if-does-not-exist :ignore))))
-  nil (1 1 "asdf"))
+  nil (1 "asdf"))
 
 (deftest :fddl/view/4
     (with-dataset *ds-fddl*
       (progn
        (clsql:create-view [v1]
                           :column-list '([x] [y] [z])
-                          :as [select [a] [b] [c]
+                          :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] [z]
+                    (clsql:select [x] [y] 
                                   :from [v1]
                                   :where [= [x] -1])
                     ;; Should exist
-                    (car (clsql:select [x] [y] [z]
+                    (car (clsql:select [x] [y] 
                                        :from [v1]
                                        :where [= [x] 1])))))
 
               (apply #'values result))
          (clsql:drop-view [v1] :if-does-not-exist :ignore))))
-  nil (1 1 "asdf"))
+  ("x" "y" "z") nil (1 "asdf"))
 
 ;; create an index, test for existence, drop it and test again
 (deftest :fddl/index/1
     (with-dataset *ds-fddl*
       (progn (clsql:create-index [bar] :on [alpha] :attributes
-                                '([a] [b] [c]) :unique t)
+                                '([a] [c]) :unique t)
             (values
-              (clsql:index-exists-p [bar] :owner *test-database-user*)
+              (clsql:index-exists-p [bar] )
               (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 nil)
 
 ;; create indexes with names as strings, symbols and in square brackets
@@ -273,7 +295,7 @@
            (result '()))
        (dolist (name names)
          (clsql:create-index name :on [alpha] :attributes '([a]))
-         (push (clsql:index-exists-p name :owner *test-database-user*) result)
+         (push (clsql:index-exists-p name ) result)
          (clsql:drop-index name :on [alpha] :if-does-not-exist :ignore))
        (apply #'values result)))
   t t t)
@@ -294,7 +316,7 @@
        (sort
        (mapcar
         #'string-downcase
-        (clsql:list-indexes :on [i3test] :owner *test-database-user*))
+        (clsql:list-indexes :on [i3test]))
        #'string-lessp)
        (progn
         (clsql:drop-index [bar] :on [i3test])
@@ -307,10 +329,10 @@
 (deftest :fddl/sequence/1
     (progn (clsql:create-sequence [foo])
           (values
-           (clsql:sequence-exists-p [foo] :owner *test-database-user*)
+           (clsql:sequence-exists-p [foo])
            (progn
              (clsql:drop-sequence [foo] :if-does-not-exist :ignore)
-             (clsql:sequence-exists-p [foo] :owner *test-database-user*))))
+             (clsql:sequence-exists-p [foo]))))
   t nil)
 
 ;; create and increment a sequence
@@ -348,6 +370,65 @@
          (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

diff --git a/tests/test-init.lisp b/tests/test-init.lisp
index fd61e924323e54bf5d0c03b55703130c19d547a6..500b89852125ee48a8af06f7882317f69741a313 100644 (file)
--- a/tests/test-init.lisp
+++ b/tests/test-init.lisp
@@ -30,6 +30,8 @@
 (defvar *test-database-type* nil)
 (defvar *test-database-underlying-type* nil)
 (defvar *test-database-user* nil)
+(defvar *test-false-database-user* "adsfjalsdkfjlakjsdfl"
+  "For testing ownership, a user that isn't the owner.")
 (defvar *test-start-utime* nil)
 (defvar *test-connection-spec* nil)
 (defvar *test-connection-db-type* nil)
@@ -44,7 +46,7 @@
   (setf *test-database-type* db-type)
   (setf *test-database-user*
     (cond
-     ((eq :oracle db-type) (second spec))
+     ((member db-type '(:oracle :odbc :aodbc)) (second spec))
      ((>= (length spec) 3) (third spec))))
 
   ;; Connect to the database
@@ -107,14 +109,15 @@
     (when (db-type-spec db-type specs)
       (clsql-sys:initialize-database-type :database-type db-type))))
 
-(defun write-report-banner (report-type db-type stream)
+(defun write-report-banner (report-type db-type stream db-name)
   (format stream
           "~&
 ******************************************************************************
 ***     CLSQL ~A begun at ~A
 ***     ~A
 ***     ~A on ~A
-***     Database ~:@(~A~) backend~A.
+***     Database ~:@(~A~)
+***     Type: ~:@(~A~) backend~A.
 ******************************************************************************
 "
           report-type
@@ -124,6 +127,7 @@
           (lisp-implementation-type)
           (lisp-implementation-version)
           (machine-type)
+         db-name
           db-type
           (if (not (eq db-type *test-database-underlying-type*))
               (format nil " with underlying type ~:@(~A~)"
@@ -138,7 +142,8 @@
        (multiple-value-bind (test-forms skip-tests)
            (compute-tests-for-backend db-type *test-database-underlying-type*)
 
-           (write-report-banner "Test Suite" db-type *report-stream*)
+           (write-report-banner "Test Suite" db-type *report-stream*
+                               (database-name-from-spec spec db-type))
 
 ;           (test-initialise-database)
 
@@ -224,12 +229,20 @@
            (push (cons test "syntax not supported.") skip-tests))
           ((and (eq *test-database-type* :odbc)
                 (eq *test-database-underlying-type* :postgresql)
-                (clsql-sys:in test :fddl/owner/1))
-           (push (cons test "table ownership not supported by postgresql odbc driver.") skip-tests))
+                (clsql-sys:in test :fddl/owner/1 :fddl/owner/table
+                             :fddl/owner/attributes
+                             :fddl/owner/attribute-types
+                             :fddl/owner/index
+                             :fddl/owner/sequence))
+          (push (cons test "table ownership not supported by postgresql odbc driver.") skip-tests))
           ((and (not (member *test-database-underlying-type*
                              '(:postgresql :oracle)))
-                (clsql-sys:in test :fddl/owner/1))
-           (push (cons test "table ownership not supported.") skip-tests))
+                (clsql-sys:in test :fddl/owner/1 :fddl/owner/table
+                             :fddl/owner/attributes
+                             :fddl/owner/attribute-types
+                             :fddl/owner/index
+                             :fddl/owner/sequence))
+          (push (cons test "table ownership not supported.") skip-tests))
           ((and (null (clsql-sys:db-type-has-intersect? db-underlying-type))
                 (clsql-sys:in test :fdml/query/7))
            (push (cons test "intersect not supported.") skip-tests))

diff --git a/tests/test-syntax.lisp b/tests/test-syntax.lisp
index bf647f1d789f8dce599d3e3deafbee990461ef20..1127d3294c213970996d950b2cc9d3958e03db3e 100644 (file)
--- a/tests/test-syntax.lisp
+++ b/tests/test-syntax.lisp
@@ -134,17 +134,46 @@
 
 
 (deftest :syntax/logical/1
-    (clsql:sql [and [foo] [bar]])
-  "(FOO AND BAR)")
-
-(deftest :syntax/logical/2
-    (clsql:sql [or [foo] [bar]])
+    (values (clsql:sql [and [foo] [bar]])
+           (clsql:sql [or [foo] [bar]]))
+  "(FOO AND BAR)"
   "(FOO OR BAR)")
 
-(deftest :syntax/logical/3
+(deftest :syntax/logical/2
     (clsql:sql [not [foo]])
   "(NOT (FOO))")
 
+;;; Test how we apply logical operators when we have different numbers of children
+;;; This is useful if we wish to (apply #'sql-and some-list) without having to do
+;;; alot of length checking
+(deftest :syntax/logical/3
+    (values (clsql:sql [and ])
+           (clsql:sql [and [foo]])
+           (clsql:sql [and [not [foo]]])
+           (clsql:sql [and [foo] [bar] [baz]]))
+  ""
+  "FOO"
+  "(NOT (FOO))"
+  "(FOO AND BAR AND BAZ)")
+
+(deftest :syntax/logical/4
+    (clsql:sql [and [= [foo] [bar]]])
+  "(FOO = BAR)")
+
+(deftest :syntax/logical/5
+  (clsql:sql [and [= [foo] [bar]]
+                 [= [bar] [bast]]
+                 [= [block] [blech]]])
+  "((FOO = BAR) AND (BAR = BAST) AND (BLOCK = BLECH))")
+
+(deftest :syntax/logical/6
+    (clsql:sql
+     (apply #'sql-and
+           (list [= [foo] [bar]]
+                 [and ]
+                 [and [= [bar] [bast]]])))
+  "((FOO = BAR) AND (BAR = BAST))")
+
 
 (deftest :syntax/null/1
     (clsql:sql [null [foo]])