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 ))
  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])
  56             (progn
  57               (clsql:drop-table [foo] :if-does-not-exist :ignore)
  58               (clsql:table-exists-p [foo]))))
  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] ))
 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               #'string<)))
 154   "a" "c" "d" "f")
 155
 156 ;; Attribute types are vendor specific so need to test a range
 157 (deftest :fddl/attributes/3
 158     (with-dataset *ds-fddl*
 159       (and (member (clsql:attribute-type [a] [alpha]) '(:int :integer :int4 :number)) t))
 160   t)
 161
 162 (deftest :fddl/attributes/4
 163     (with-dataset *ds-fddl*
 164       (multiple-value-bind (type length scale nullable)
 165           (clsql:attribute-type [c] [alpha])
 166         (values (clsql-sys:in type :varchar :varchar2) length scale nullable)))
 167   t 30 nil 1)
 168
 169 (deftest :fddl/attributes/5
 170     (with-dataset *ds-fddl*
 171       (and (member (clsql:attribute-type [d] [alpha]) '(:datetime :timestamp :date)) t))
 172   t)
 173
 174 (deftest :fddl/attributes/6
 175     (with-dataset *ds-fddl*
 176       (and (member (clsql:attribute-type [f] [alpha]) '(:float :float8 :number)) t))
 177   t)
 178
 179 (deftest :fddl/attributes/7
 180     (with-dataset *ds-bigint*
 181       (and (member (clsql:attribute-type [t_bigint] [TYPE_BIGINT]) '(:bigint :int8)) t))
 182   t)
 183
 184
 185 ;; create a view, test for existence, drop it and test again
 186 (deftest :fddl/view/1
 187     (with-dataset *ds-fddl*
 188       (progn (clsql:create-view [v1]
 189                                 :as [select [a] [c] [d]
 190                                             :from [alpha]
 191                                             :where [= [a] 1]])
 192              (values
 193                (clsql:view-exists-p [v1])
 194                (progn
 195                  (clsql:drop-view [v1] :if-does-not-exist :ignore)
 196                  (clsql:view-exists-p [v1])))))
 197   t nil)
 198
 199   ;; create a view, list its attributes and drop it
 200 (deftest :fddl/view/2
 201       (with-dataset *ds-fddl*
 202         (progn (clsql:create-view [v1]
 203                               :as [select [a] [c] [d]
 204                                           :from [alpha]
 205                                           :where [= [a] 1]])
 206              (unwind-protect
 207                   (sort (mapcar #'string-downcase
 208                                 (clsql:list-attributes [v1]))
 209                         #'string<)
 210                (clsql:drop-view [v1] :if-does-not-exist :ignore))))
 211     ("a" "c" "d"))
 212
 213   ;; create a view, select stuff from it and drop it
 214 (deftest :fddl/view/3
 215     (with-dataset *ds-fddl*
 216       (progn
 217         (clsql:create-view [v1]
 218                            :as [select [a] [c] [d]
 219                                        :from [alpha]
 220                                        :where [= [a] 1]])
 221         (unwind-protect
 222              (let ((result
 223                     (list
 224                      ;; Shouldn't exist
 225                      (clsql:select [a] [c]
 226                                    :from [v1]
 227                                    :where [= [a] -1])
 228                      ;; Should exist
 229                      (car (clsql:select [a] [c]
 230                                         :from [v1]
 231                                         :where [= [a] 1])))))
 232
 233                (apply #'values result))
 234           (clsql:drop-view [v1] :if-does-not-exist :ignore))))
 235   nil (1 "asdf"))
 236
 237 (deftest :fddl/view/4
 238     (with-dataset *ds-fddl*
 239       (progn
 240         (clsql:create-view [v1]
 241                            :column-list '([x] [y] [z])
 242                            :as [select [a] [c] [d]
 243                                        :from [alpha]
 244                                        :where [= [a] 1]])
 245         (unwind-protect
 246              (let ((result
 247                     (list
 248                      (sort (mapcar #'string-downcase
 249                                    (clsql:list-attributes [v1]))
 250                            #'string<)
 251                      ;; Shouldn't exist
 252                      (clsql:select [x] [y]
 253                                    :from [v1]
 254                                    :where [= [x] -1])
 255                      ;; Should exist
 256                      (car (clsql:select [x] [y]
 257                                         :from [v1]
 258                                         :where [= [x] 1])))))
 259
 260                (apply #'values result))
 261           (clsql:drop-view [v1] :if-does-not-exist :ignore))))
 262   ("x" "y" "z") nil (1 "asdf"))
 263
 264 ;; create an index, test for existence, drop it and test again
 265 (deftest :fddl/index/1
 266     (with-dataset *ds-fddl*
 267       (progn (clsql:create-index [bar] :on [alpha] :attributes
 268                                  '([a] [c]) :unique t)
 269              (values
 270                (clsql:index-exists-p [bar] )
 271                (progn
 272                  (clsql:drop-index [bar] :on [alpha]
 273                                    :if-does-not-exist :ignore)
 274                  (clsql:index-exists-p [bar])))))
 275   t nil)
 276
 277 ;; create indexes with names as strings, symbols and in square brackets
 278 (deftest :fddl/index/2
 279     (with-dataset *ds-fddl*
 280       (let ((names '("foo" foo [foo]))
 281             (result '()))
 282         (dolist (name names)
 283           (clsql:create-index name :on [alpha] :attributes '([a]))
 284           (push (clsql:index-exists-p name ) result)
 285           (clsql:drop-index name :on [alpha] :if-does-not-exist :ignore))
 286         (apply #'values result)))
 287   t t t)
 288
 289 ;; test list-indexes with keyword :ON
 290 (deftest :fddl/index/3
 291     (progn
 292       (clsql:create-table [i3test] '(([a] (string 10))
 293                                      ([b] integer)))
 294       (clsql:create-index [foo] :on [i3test] :attributes
 295        '([b]) :unique nil)
 296       (clsql:create-index [bar] :on [i3test] :attributes
 297        '([a]) :unique t)
 298       (values
 299        (clsql:table-exists-p [i3test])
 300        (clsql:index-exists-p [foo])
 301        (clsql:index-exists-p [bar])
 302        (sort
 303         (mapcar
 304          #'string-downcase
 305          (clsql:list-indexes :on [i3test]))
 306         #'string-lessp)
 307        (progn
 308          (clsql:drop-index [bar] :on [i3test])
 309          (clsql:drop-index [foo] :on [i3test])
 310          (clsql:drop-table [i3test])
 311          t)))
 312   t t t ("bar" "foo") t)
 313
 314 ;; create an sequence, test for existence, drop it and test again
 315 (deftest :fddl/sequence/1
 316     (progn (clsql:create-sequence [foo])
 317            (values
 318             (clsql:sequence-exists-p [foo])
 319             (progn
 320               (clsql:drop-sequence [foo] :if-does-not-exist :ignore)
 321               (clsql:sequence-exists-p [foo]))))
 322   t nil)
 323
 324 ;; create and increment a sequence
 325 (deftest :fddl/sequence/2
 326     (let ((val1 nil))
 327       (clsql:create-sequence [foo])
 328       (setf val1 (clsql:sequence-next [foo]))
 329       (prog1
 330           (< val1 (clsql:sequence-next [foo]))
 331         (clsql:drop-sequence [foo] :if-does-not-exist :ignore)))
 332   t)
 333
 334 ;; explicitly set the value of a sequence
 335 (deftest :fddl/sequence/3
 336     (progn
 337       (clsql:create-sequence [foo])
 338       (clsql:set-sequence-position [foo] 5)
 339       (prog1
 340           (clsql:sequence-next [foo])
 341         (clsql:drop-sequence [foo] :if-does-not-exist :ignore)))
 342   6)
 343
 344
 345
 346 (deftest :fddl/owner/1
 347     (with-dataset *ds-fddl*
 348       (and
 349        ;; user tables are an improper subset of all tables
 350        (= (length (intersection (clsql:list-tables :owner nil)
 351                                 (clsql:list-tables :owner :all)
 352                                 :test #'string=))
 353           (length (clsql:list-tables :owner nil)))
 354        ;; user tables are a proper subset of all tables
 355        (> (length (clsql:list-tables :owner :all))
 356           (length (clsql:list-tables :owner nil)))))
 357   t)
 358
 359 (deftest :fddl/owner/table
 360     (with-dataset *ds-fddl*
 361       (values
 362         (clsql-sys:table-exists-p [alpha])
 363         (clsql-sys:table-exists-p [alpha] :owner *test-database-user*)
 364         (clsql-sys:table-exists-p [alpha] :owner *test-false-database-user*)))
 365   t t nil)
 366
 367 (deftest :fddl/owner/attributes
 368     (with-dataset *ds-fddl*
 369       (values
 370         (length (clsql-sys:list-attributes [alpha]))
 371         (length (clsql-sys:list-attributes [alpha] :owner *test-database-user*))
 372         (length (clsql-sys:list-attributes [alpha] :owner *test-false-database-user*))))
 373   4 4 0)
 374
 375 (deftest :fddl/owner/attribute-types
 376     (with-dataset *ds-fddl*
 377       (values
 378         (length (clsql:list-attribute-types [alpha]))
 379         (length (clsql:list-attribute-types [alpha] :owner *test-database-user*))
 380         (length (clsql:list-attribute-types [alpha] :owner *test-false-database-user*))))
 381   4 4 0)
 382
 383 (deftest :fddl/owner/index
 384     (with-dataset *ds-fddl*
 385       (progn (clsql:create-index [bar] :on [alpha]
 386                                  :attributes '([a] [c]))
 387              (values
 388                (clsql:index-exists-p [bar] )
 389                (clsql:index-exists-p [bar] :owner *test-database-user*)
 390                (clsql:index-exists-p [bar] :owner *test-false-database-user*)
 391
 392                (length (clsql-sys:list-indexes :on [alpha]))
 393                (length (clsql-sys:list-indexes :on [alpha] :owner *test-database-user*))
 394                (length (clsql-sys:list-indexes :on [alpha] :owner *test-false-database-user*))
 395                (progn
 396                  (clsql:drop-index [bar] :on [alpha]
 397                                    :if-does-not-exist :ignore)
 398                  (clsql:index-exists-p [bar] :owner *test-database-user*))
 399                (clsql:index-exists-p [bar] ))))
 400   t t nil
 401   1 1 0
 402   nil nil)
 403
 404 (deftest :fddl/owner/sequence
 405     (progn (clsql:create-sequence [foo])
 406            (values
 407             (clsql:sequence-exists-p [foo])
 408             (clsql:sequence-exists-p [foo] :owner *test-database-user*)
 409             (clsql:sequence-exists-p [foo] :owner *test-false-database-user*)
 410
 411             (progn
 412               (clsql:drop-sequence [foo] :if-does-not-exist :ignore)
 413               (clsql:sequence-exists-p [foo] ))))
 414   t t nil nil)
 415
 416
 417
 418 (deftest :fddl/cache-table-queries/1
 419     (with-dataset *ds-fddl*
 420       (list
 421        (gethash "ALPHA" (clsql-sys::attribute-cache clsql:*default-database*))
 422        (progn
 423          (clsql:cache-table-queries "ALPHA" :action t)
 424          (gethash "ALPHA" (clsql-sys::attribute-cache clsql:*default-database*)))
 425        (progn
 426          (clsql:list-attribute-types "ALPHA")
 427          (not
 428           (null
 429            (cadr
 430             (gethash "ALPHA"
 431                      (clsql-sys::attribute-cache clsql:*default-database*))))))
 432        (progn
 433          (clsql:cache-table-queries "ALPHA" :action :flush)
 434          (gethash "ALPHA" (clsql-sys::attribute-cache clsql:*default-database*)))))
 435   (nil (t nil) t (t nil)))
 436
 437   ))
 438
 439 #.(clsql:restore-sql-reader-syntax-state)