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