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