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/attributes/1
  83     (apply #'values
  84            (sort
  85             (mapcar #'string-downcase
  86                     (clsql:list-attributes [employee]
  87                                            :owner *test-database-user*))
  88             #'string<))
  89   "birthday" "ecompanyid" "email" "emplid" "first_name" "groupid" "height"
  90   "last_name" "managerid" "married")
  91
  92 (deftest :fddl/attributes/2
  93     (apply #'values
  94            (sort
  95             (mapcar #'(lambda (a) (string-downcase (car a)))
  96                     (clsql:list-attribute-types [employee]
  97                                                :owner *test-database-user*))
  98             #'string<))
  99   "birthday" "ecompanyid" "email" "emplid" "first_name" "groupid" "height"
 100   "last_name" "managerid" "married")
 101
 102 ;; Attribute types are vendor specific so need to test a range
 103 (deftest :fddl/attributes/3
 104     (and (member (clsql:attribute-type [emplid] [employee]) '(:int :integer :int4 :number)) t)
 105   t)
 106
 107 (deftest :fddl/attributes/4
 108     (multiple-value-bind (type length scale nullable)
 109         (clsql:attribute-type [first-name] [employee])
 110       (values (clsql-sys:in type :varchar :varchar2) length scale nullable))
 111   t 30 nil 1)
 112
 113 (deftest :fddl/attributes/5
 114     (and (member (clsql:attribute-type [birthday] [employee]) '(:datetime :timestamp :date)) t)
 115   t)
 116
 117 (deftest :fddl/attributes/6
 118     (and (member (clsql:attribute-type [height] [employee]) '(:float :float8 :number)) t)
 119   t)
 120
 121
 122
 123 ;; create a view, test for existence, drop it and test again
 124 (deftest :fddl/view/1
 125     (progn (clsql:create-view [lenins-group]
 126                               :as [select [first-name] [last-name] [email]
 127                                           :from [employee]
 128                                           :where [= [managerid] 1]])
 129            (values
 130             (clsql:view-exists-p [lenins-group] :owner *test-database-user*)
 131             (progn
 132               (clsql:drop-view [lenins-group] :if-does-not-exist :ignore)
 133               (clsql:view-exists-p [lenins-group] :owner *test-database-user*))))
 134   t nil)
 135
 136   ;; create a view, list its attributes and drop it
 137 (when (clsql-sys:db-type-has-views? *test-database-underlying-type*)
 138   (deftest :fddl/view/2
 139       (progn (clsql:create-view [lenins-group]
 140                                 :as [select [first-name] [last-name] [email]
 141                                             :from [employee]
 142                                             :where [= [managerid] 1]])
 143              (prog1
 144                  (sort (mapcar #'string-downcase
 145                                (clsql:list-attributes [lenins-group]))
 146                        #'string<)
 147                (clsql:drop-view [lenins-group] :if-does-not-exist :ignore)))
 148     ("email" "first_name" "last_name")))
 149
 150   ;; create a view, select stuff from it and drop it
 151 (deftest :fddl/view/3
 152     (progn (clsql:create-view [lenins-group]
 153                               :as [select [first-name] [last-name] [email]
 154                                           :from [employee]
 155                                           :where [= [managerid] 1]])
 156            (let ((result
 157                   (list
 158                    ;; Shouldn't exist
 159                    (clsql:select [first-name] [last-name] [email]
 160                                  :from [lenins-group]
 161                                  :where [= [last-name] "Lenin"])
 162                    ;; Should exist
 163                    (car (clsql:select [first-name] [last-name] [email]
 164                                       :from [lenins-group]
 165                                       :where [= [last-name] "Stalin"])))))
 166              (clsql:drop-view [lenins-group] :if-does-not-exist :ignore)
 167              (apply #'values result)))
 168   nil ("Josef" "Stalin" "stalin@soviet.org"))
 169
 170 (deftest :fddl/view/4
 171     (progn (clsql:create-view [lenins-group]
 172                               :column-list '([forename] [surname] [email])
 173                               :as [select [first-name] [last-name] [email]
 174                                           :from [employee]
 175                                           :where [= [managerid] 1]])
 176            (let ((result
 177                   (list
 178                    ;; Shouldn't exist
 179                    (clsql:select [forename] [surname] [email]
 180                                  :from [lenins-group]
 181                                  :where [= [surname] "Lenin"])
 182                    ;; Should exist
 183                    (car (clsql:select [forename] [surname] [email]
 184                                       :from [lenins-group]
 185                                       :where [= [surname] "Stalin"])))))
 186              (clsql:drop-view [lenins-group] :if-does-not-exist :ignore)
 187              (apply #'values result)))
 188   nil ("Josef" "Stalin" "stalin@soviet.org"))
 189
 190 ;; create an index, test for existence, drop it and test again
 191 (deftest :fddl/index/1
 192     (progn (clsql:create-index [bar] :on [employee] :attributes
 193                               '([first-name] [last-name] [email]) :unique t)
 194            (values
 195             (clsql:index-exists-p [bar] :owner *test-database-user*)
 196             (progn
 197               (clsql:drop-index [bar] :on [employee]
 198                                 :if-does-not-exist :ignore)
 199               (clsql:index-exists-p [bar] :owner *test-database-user*))))
 200   t nil)
 201
 202 ;; create indexes with names as strings, symbols and in square brackets
 203 (deftest :fddl/index/2
 204     (let ((names '("foo" foo [foo]))
 205           (result '()))
 206       (dolist (name names)
 207         (clsql:create-index name :on [employee] :attributes '([emplid]))
 208         (push (clsql:index-exists-p name :owner *test-database-user*) result)
 209         (clsql:drop-index name :on [employee] :if-does-not-exist :ignore))
 210       (apply #'values result))
 211   t t t)
 212
 213 ;; test list-table-indexes
 214 (deftest :fddl/index/3
 215     (progn
 216       (clsql:create-table [i3test] '(([a] (string 10))
 217                                      ([b] integer)))
 218       (clsql:create-index [foo] :on [i3test] :attributes
 219        '([b]) :unique nil)
 220       (clsql:create-index [bar] :on [i3test] :attributes
 221        '([a]) :unique t)
 222       (values
 223        (clsql:table-exists-p [i3test])
 224        (clsql:index-exists-p [foo])
 225        (clsql:index-exists-p [bar])
 226        (sort
 227         (mapcar
 228          #'string-downcase
 229          (clsql:list-table-indexes [i3test] :owner *test-database-user*))
 230         #'string-lessp)
 231        (progn
 232          (clsql:drop-index [bar] :on [i3test])
 233          (clsql:drop-index [foo] :on [i3test])
 234          (clsql:drop-table [i3test])
 235          t)))
 236   t t t ("bar" "foo") t)
 237
 238 ;; create an sequence, test for existence, drop it and test again
 239 (deftest :fddl/sequence/1
 240     (progn (clsql:create-sequence [foo])
 241            (values
 242             (clsql:sequence-exists-p [foo] :owner *test-database-user*)
 243             (progn
 244               (clsql:drop-sequence [foo] :if-does-not-exist :ignore)
 245               (clsql:sequence-exists-p [foo] :owner *test-database-user*))))
 246   t nil)
 247
 248 ;; create and increment a sequence
 249 (deftest :fddl/sequence/2
 250     (let ((val1 nil))
 251       (clsql:create-sequence [foo])
 252       (setf val1 (clsql:sequence-next [foo]))
 253       (prog1
 254           (< val1 (clsql:sequence-next [foo]))
 255         (clsql:drop-sequence [foo] :if-does-not-exist :ignore)))
 256   t)
 257
 258 ;; explicitly set the value of a sequence
 259 (deftest :fddl/sequence/3
 260     (progn
 261       (clsql:create-sequence [foo])
 262       (clsql:set-sequence-position [foo] 5)
 263       (prog1
 264           (clsql:sequence-next [foo])
 265         (clsql:drop-sequence [foo] :if-does-not-exist :ignore)))
 266   6)
 267
 268 (deftest :fddl/big/1
 269     (let ((rows (clsql:select [*] :from [big] :field-names nil)))
 270       (values
 271        (length rows)
 272        (do ((i 0 (1+ i))
 273             (max (expt 2 60))
 274             (rest rows (cdr rest)))
 275            ((= i (length rows)) t)
 276          (let ((row (car rest))
 277                (index (1+ i)))
 278            (unless (and (eql (first row) index)
 279                         (eql (second row) (truncate max index)))
 280              (return nil))))))
 281   555 t)
 282
 283
 284 ))
 285
 286 #.(clsql:restore-sql-reader-syntax-state)