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