tests/test-fddl.lisp

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