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