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