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