tests/test-fddl.lisp

   1 ;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
   2 ;;;; ======================================================================
   3 ;;;; File:     test-fddl.lisp
   4 ;;;; Authors:  Marcus Pearce <m.t.pearce@city.ac.uk> and Kevin Rosenberg
   5 ;;;; Created:  30/03/2004
   6 ;;;; Updated:  $Id$
   7 ;;;;
   8 ;;;; Tests for the CLSQL Functional Data Definition Language
   9 ;;;; (FDDL).
  10 ;;;;
  11 ;;;; This file is part of CLSQL.
  12 ;;;;
  13 ;;;; CLSQL users are granted the rights to distribute and use this software
  14 ;;;; as governed by the terms of the Lisp Lesser GNU Public License
  15 ;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL.
  16 ;;;; ======================================================================
  17
  18 (in-package #:clsql-tests)
  19
  20 #.(clsql:locally-enable-sql-reader-syntax)
  21
  22 (def-dataset *ds-fddl*
  23   (:setup (lambda ()
  24             (create-table [alpha] '(([a] integer)
  25                                     ([c] (varchar 30))
  26                                     ([d] date)
  27                                     ([f] float)))
  28             (create-table [bravo] '(([foo] integer)
  29                                     ([bar] integer)))))
  30   (:sqldata "ALPHA" "A,C,D,F"
  31             "1,'asdf','2010-01-01',3.14"
  32             "2,'blarg','2012-12-21',0.1"
  33             "3,'matey','1992-02-29',0.0")
  34   (:cleanup "DROP TABLE ALPHA" "DROP TABLE BRAVO"))
  35
  36 (setq *rt-fddl*
  37       '(
  38
  39 ;; list current tables
  40 (deftest :fddl/table/1
  41     (with-dataset *ds-fddl*
  42       (sort (mapcar #'string-downcase
  43                     (clsql:list-tables :owner *test-database-user*))
  44             #'string<))
  45   ("alpha" "bravo"))
  46
  47 ;; create a table, test for its existence, drop it and test again
  48 (deftest :fddl/table/2
  49     (progn (clsql:create-table  [foo]
  50                                '(([id] integer)
  51                                  ([height] float)
  52                                  ([name] (string 24))
  53                                  ([comments] longchar)))
  54            (values
  55             (clsql:table-exists-p [foo] :owner *test-database-user*)
  56             (progn
  57               (clsql:drop-table [foo] :if-does-not-exist :ignore)
  58               (clsql:table-exists-p [foo] :owner *test-database-user*))))
  59   t nil)
  60
  61 ;; create a table, list its attributes and drop it
  62 (deftest :fddl/table/3
  63     (apply #'values
  64            (progn (clsql:create-table  [foo]
  65                                       '(([id] integer)
  66                                         ([height] float)
  67                                         ([name] (char 255))
  68                                         ([comments] longchar)))
  69                   (prog1
  70                       (sort (mapcar #'string-downcase
  71                                     (clsql:list-attributes [foo]))
  72                             #'string<)
  73                     (clsql:drop-table [foo] :if-does-not-exist :ignore))))
  74   "comments" "height" "id" "name")
  75
  76 (deftest :fddl/table/4
  77     (values
  78      (clsql:table-exists-p "MyMixedCase")
  79      (progn
  80        (clsql:create-table "MyMixedCase" '(([a] integer)))
  81        (clsql:table-exists-p "MyMixedCase"))
  82      (progn
  83        (clsql:drop-table "MyMixedCase")
  84        (clsql:table-exists-p "MyMixedCase")))
  85   nil t nil)
  86
  87 (deftest :fddl/table/5
  88     (prog1
  89         (progn
  90           (clsql:create-table "MyMixedCase" '(([a] integer)))
  91           (clsql:execute-command "insert into \"MyMixedCase\" values (5)")
  92            (clsql:insert-records :into "MyMixedCase" :values '(6))
  93            (clsql:select [a] :from "MyMixedCase" :order-by '((a :asc))))
  94       (clsql:drop-table "MyMixedCase"))
  95   ((5) (6)))
  96
  97 (deftest :fddl/table/6
  98     (values
  99      (clsql:table-exists-p [foo])
 100      (progn
 101        (let ((*backend-warning-behavior*
 102               (if (member *test-database-type*
 103                           '(:postgresql :postgresql-socket))
 104                   :ignore
 105                   :warn)))
 106          (case *test-database-underlying-type*
 107            (:mssql (clsql:create-table [foo]
 108                                        '(([bar] integer :not-null :primary-key)
 109                                          ([baz] string :not-null :unique))))
 110            (t (clsql:create-table [foo]
 111                                   '(([bar] integer :not-null :unique :primary-key)
 112                                     ([baz] string :not-null :unique))))))
 113        (clsql:table-exists-p [foo]))
 114      (progn
 115        (clsql:drop-table [foo])
 116        (clsql:table-exists-p [foo])))
 117   nil t nil)
 118
 119 (deftest :fddl/table/7
 120     (values
 121      (clsql:table-exists-p [foo])
 122      (progn
 123        (let ((*backend-warning-behavior*
 124               (if (member *test-database-type*
 125                           '(:postgresql :postgresql-socket))
 126                   :ignore
 127                   :warn)))
 128          (clsql:create-table [foo] '(([bar] integer :not-null)
 129                                      ([baz] string :not-null))
 130                              :constraints '("UNIQUE (bar,baz)"
 131                                             "PRIMARY KEY (bar)")))
 132        (clsql:table-exists-p [foo]))
 133      (progn
 134        (clsql:drop-table [foo])
 135        (clsql:table-exists-p [foo])))
 136   nil t nil)
 137
 138 (deftest :fddl/attributes/1
 139     (apply #'values
 140      (with-dataset *ds-fddl*
 141        (sort
 142         (mapcar #'string-downcase
 143                 (clsql:list-attributes [alpha] :owner *test-database-user*))
 144         #'string<)))
 145   "a" "c" "d" "f")
 146
 147 (deftest :fddl/attributes/2
 148     (with-dataset *ds-fddl*
 149       (apply #'values
 150              (sort
 151               (mapcar #'(lambda (a) (string-downcase (car a)))
 152                       (clsql:list-attribute-types [alpha]
 153                                                   :owner *test-database-user*))
 154               #'string<)))
 155   "a" "c" "d" "f")
 156
 157 ;; Attribute types are vendor specific so need to test a range
 158 (deftest :fddl/attributes/3
 159     (with-dataset *ds-fddl*
 160       (and (member (clsql:attribute-type [a] [alpha]) '(:int :integer :int4 :number)) t))
 161   t)
 162
 163 (deftest :fddl/attributes/4
 164     (with-dataset *ds-fddl*
 165       (multiple-value-bind (type length scale nullable)
 166           (clsql:attribute-type [c] [alpha])
 167         (values (clsql-sys:in type :varchar :varchar2) length scale nullable)))
 168   t 30 nil 1)
 169
 170 (deftest :fddl/attributes/5
 171     (with-dataset *ds-fddl*
 172       (and (member (clsql:attribute-type [d] [alpha]) '(:datetime :timestamp :date)) t))
 173   t)
 174
 175 (deftest :fddl/attributes/6
 176     (with-dataset *ds-fddl*
 177       (and (member (clsql:attribute-type [f] [alpha]) '(:float :float8 :number)) t))
 178   t)
 179
 180 (deftest :fddl/attributes/7
 181     (with-dataset *ds-bigint*
 182       (and (member (clsql:attribute-type [t_bigint] [TYPE_BIGINT]) '(:bigint :int8)) t))
 183   t)
 184
 185
 186 ;; create a view, test for existence, drop it and test again
 187 (deftest :fddl/view/1
 188     (with-dataset *ds-fddl*
 189       (progn (clsql:create-view [v1]
 190                                 :as [select [a] [c] [d]
 191                                             :from [alpha]
 192                                             :where [= [a] 1]])
 193              (values
 194                (clsql:view-exists-p [v1])
 195                (progn
 196                  (clsql:drop-view [v1] :if-does-not-exist :ignore)
 197                  (clsql:view-exists-p [v1])))))
 198   t nil)
 199
 200   ;; create a view, list its attributes and drop it
 201 (deftest :fddl/view/2
 202       (with-dataset *ds-fddl*
 203         (progn (clsql:create-view [v1]
 204                               :as [select [a] [c] [d]
 205                                           :from [alpha]
 206                                           :where [= [a] 1]])
 207              (unwind-protect
 208                   (sort (mapcar #'string-downcase
 209                                 (clsql:list-attributes [v1]))
 210                         #'string<)
 211                (clsql:drop-view [v1] :if-does-not-exist :ignore))))
 212     ("a" "c" "d"))
 213
 214   ;; create a view, select stuff from it and drop it
 215 (deftest :fddl/view/3
 216     (with-dataset *ds-fddl*
 217       (progn
 218         (clsql:create-view [v1]
 219                            :as [select [a] [c] [d]
 220                                        :from [alpha]
 221                                        :where [= [a] 1]])
 222         (unwind-protect
 223              (let ((result
 224                     (list
 225                      ;; Shouldn't exist
 226                      (clsql:select [a] [c]
 227                                    :from [v1]
 228                                    :where [= [a] -1])
 229                      ;; Should exist
 230                      (car (clsql:select [a] [c]
 231                                         :from [v1]
 232                                         :where [= [a] 1])))))
 233
 234                (apply #'values result))
 235           (clsql:drop-view [v1] :if-does-not-exist :ignore))))
 236   nil (1 "asdf"))
 237
 238 (deftest :fddl/view/4
 239     (with-dataset *ds-fddl*
 240       (progn
 241         (clsql:create-view [v1]
 242                            :column-list '([x] [y] [z])
 243                            :as [select [a] [c] [d]
 244                                        :from [alpha]
 245                                        :where [= [a] 1]])
 246         (unwind-protect
 247              (let ((result
 248                     (list
 249                      (sort (mapcar #'string-downcase
 250                                    (clsql:list-attributes [v1]))
 251                            #'string<)
 252                      ;; Shouldn't exist
 253                      (clsql:select [x] [y]
 254                                    :from [v1]
 255                                    :where [= [x] -1])
 256                      ;; Should exist
 257                      (car (clsql:select [x] [y]
 258                                         :from [v1]
 259                                         :where [= [x] 1])))))
 260
 261                (apply #'values result))
 262           (clsql:drop-view [v1] :if-does-not-exist :ignore))))
 263   ("x" "y" "z") nil (1 "asdf"))
 264
 265 ;; create an index, test for existence, drop it and test again
 266 (deftest :fddl/index/1
 267     (with-dataset *ds-fddl*
 268       (progn (clsql:create-index [bar] :on [alpha] :attributes
 269                                  '([a] [c]) :unique t)
 270              (values
 271                (clsql:index-exists-p [bar] :owner *test-database-user*)
 272                (progn
 273                  (clsql:drop-index [bar] :on [alpha]
 274                                    :if-does-not-exist :ignore)
 275                  (clsql:index-exists-p [bar] :owner *test-database-user*)))))
 276   t nil)
 277
 278 ;; create indexes with names as strings, symbols and in square brackets
 279 (deftest :fddl/index/2
 280     (with-dataset *ds-fddl*
 281       (let ((names '("foo" foo [foo]))
 282             (result '()))
 283         (dolist (name names)
 284           (clsql:create-index name :on [alpha] :attributes '([a]))
 285           (push (clsql:index-exists-p name :owner *test-database-user*) result)
 286           (clsql:drop-index name :on [alpha] :if-does-not-exist :ignore))
 287         (apply #'values result)))
 288   t t t)
 289
 290 ;; test list-indexes with keyword :ON
 291 (deftest :fddl/index/3
 292     (progn
 293       (clsql:create-table [i3test] '(([a] (string 10))
 294                                      ([b] integer)))
 295       (clsql:create-index [foo] :on [i3test] :attributes
 296        '([b]) :unique nil)
 297       (clsql:create-index [bar] :on [i3test] :attributes
 298        '([a]) :unique t)
 299       (values
 300        (clsql:table-exists-p [i3test])
 301        (clsql:index-exists-p [foo])
 302        (clsql:index-exists-p [bar])
 303        (sort
 304         (mapcar
 305          #'string-downcase
 306          (clsql:list-indexes :on [i3test] :owner *test-database-user*))
 307         #'string-lessp)
 308        (progn
 309          (clsql:drop-index [bar] :on [i3test])
 310          (clsql:drop-index [foo] :on [i3test])
 311          (clsql:drop-table [i3test])
 312          t)))
 313   t t t ("bar" "foo") t)
 314
 315 ;; create an sequence, test for existence, drop it and test again
 316 (deftest :fddl/sequence/1
 317     (progn (clsql:create-sequence [foo])
 318            (values
 319             (clsql:sequence-exists-p [foo] :owner *test-database-user*)
 320             (progn
 321               (clsql:drop-sequence [foo] :if-does-not-exist :ignore)
 322               (clsql:sequence-exists-p [foo] :owner *test-database-user*))))
 323   t nil)
 324
 325 ;; create and increment a sequence
 326 (deftest :fddl/sequence/2
 327     (let ((val1 nil))
 328       (clsql:create-sequence [foo])
 329       (setf val1 (clsql:sequence-next [foo]))
 330       (prog1
 331           (< val1 (clsql:sequence-next [foo]))
 332         (clsql:drop-sequence [foo] :if-does-not-exist :ignore)))
 333   t)
 334
 335 ;; explicitly set the value of a sequence
 336 (deftest :fddl/sequence/3
 337     (progn
 338       (clsql:create-sequence [foo])
 339       (clsql:set-sequence-position [foo] 5)
 340       (prog1
 341           (clsql:sequence-next [foo])
 342         (clsql:drop-sequence [foo] :if-does-not-exist :ignore)))
 343   6)
 344
 345
 346
 347 (deftest :fddl/owner/1
 348     (with-dataset *ds-fddl*
 349       (and
 350        ;; user tables are an improper subset of all tables
 351        (= (length (intersection (clsql:list-tables :owner nil)
 352                                 (clsql:list-tables :owner :all)
 353                                 :test #'string=))
 354           (length (clsql:list-tables :owner nil)))
 355        ;; user tables are a proper subset of all tables
 356        (> (length (clsql:list-tables :owner :all))
 357           (length (clsql:list-tables :owner nil)))))
 358   t)
 359
 360 (deftest :fddl/cache-table-queries/1
 361     (with-dataset *ds-fddl*
 362       (list
 363        (gethash "ALPHA" (clsql-sys::attribute-cache clsql:*default-database*))
 364        (progn
 365          (clsql:cache-table-queries "ALPHA" :action t)
 366          (gethash "ALPHA" (clsql-sys::attribute-cache clsql:*default-database*)))
 367        (progn
 368          (clsql:list-attribute-types "ALPHA")
 369          (not
 370           (null
 371            (cadr
 372             (gethash "ALPHA"
 373                      (clsql-sys::attribute-cache clsql:*default-database*))))))
 374        (progn
 375          (clsql:cache-table-queries "ALPHA" :action :flush)
 376          (gethash "ALPHA" (clsql-sys::attribute-cache clsql:*default-database*)))))
 377   (nil (t nil) t (t nil)))
 378
 379   ))
 380
 381 #.(clsql:restore-sql-reader-syntax-state)