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