tests/test-fdml.lisp

   1 ;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
   2 ;;;; ======================================================================
   3 ;;;; File:    test-fdml.lisp
   4 ;;;; Author:  Marcus Pearce <m.t.pearce@city.ac.uk>, Kevin Rosenberg
   5 ;;;; Created: 30/03/2004
   6 ;;;; Updated: $Id$
   7 ;;;;
   8 ;;;; Tests for the CLSQL Functional Data Manipulation Language
   9 ;;;; (FDML).
  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-fdml*
  23       '(
  24
  25
  26 ;; Computed values are not always classified as numeric by psqlodbc
  27 (deftest :fdml/query/1
  28     (let ((count (caar (clsql:query "SELECT COUNT(*) FROM EMPLOYEE WHERE (EMAIL LIKE '%org')" :field-names nil))))
  29       (if (stringp count)
  30           (nth-value 0 (parse-integer count))
  31           (nth-value 0 (truncate count))))
  32   10)
  33
  34 (deftest :fdml/query/2
  35     (multiple-value-bind (rows field-names)
  36         (clsql:query
  37          "SELECT FIRST_NAME,LAST_NAME FROM EMPLOYEE WHERE (EMPLID <= 5) ORDER BY LAST_NAME")
  38       (values rows (mapcar 'string-upcase field-names)))
  39   (("Leonid" "Brezhnev") ("Nikita" "Kruschev") ("Vladimir" "Lenin")
  40    ("Josef" "Stalin") ("Leon" "Trotsky"))
  41   ("FIRST_NAME" "LAST_NAME"))
  42
  43 (deftest :fdml/query/3
  44     (caar (clsql:query "SELECT EMPLID FROM EMPLOYEE WHERE LAST_NAME = 'Andropov'" :field-names nil))
  45   6)
  46
  47 (deftest :fdml/query/4
  48     (typep (caar (clsql:query "SELECT HEIGHT FROM EMPLOYEE WHERE LAST_NAME = 'Andropov'" :field-names nil))
  49      'float)
  50   t)
  51
  52 (deftest :fdml/query/5
  53     (let ((res (clsql:query (clsql:sql [select [first-name] [sum [emplid]] :from [employee]]
  54                                        [group-by [first-name]] [order-by [sum [emplid]]])
  55                             :field-names nil :result-types nil)))
  56       (mapcar (lambda (p) (list (car p) (truncate (read-from-string (second p)))))
  57               res))
  58   (("Josef" 2) ("Leon" 3) ("Nikita" 4) ("Leonid" 5) ("Yuri" 6)
  59   ("Konstantin" 7) ("Mikhail" 8) ("Boris" 9) ("Vladimir" 11)))
  60
  61 (deftest :fdml/query/6
  62     (let ((res (clsql:query (clsql:sql [union [select [emplid] :from [employee]]
  63                                        [select [groupid] :from [company]]])
  64                             :field-names nil :result-types nil :flatp t)))
  65       (values (every #'stringp res)
  66               (mapcar #'(lambda (f) (truncate (read-from-string f))) res)))
  67   t (1 2 3 4 5 6 7 8 9 10))
  68
  69 (deftest :fdml/query/7
  70     (let ((res (car (clsql:query (clsql:sql [intersect [select [emplid] :from [employee]]
  71                                             [select [groupid] :from [company]]])
  72                                  :field-names nil :result-types nil :flatp t))))
  73       (values (stringp res)
  74               (nth-value 0 (truncate (read-from-string res)))))
  75   t 1)
  76
  77 (deftest :fdml/query/8
  78     (let ((res (clsql:query (clsql:sql [except [select [emplid] :from [employee]]
  79                                        [select [groupid] :from [company]]])
  80                             :field-names nil :result-types nil :flatp t)))
  81       (values (every #'stringp res)
  82               (mapcar #'(lambda (f) (truncate (read-from-string f))) res)))
  83   t (2 3 4 5 6 7 8 9 10))
  84
  85
  86 (deftest :fdml/execute-command/1
  87     (values
  88      (clsql:table-exists-p [foo] :owner *test-database-user*)
  89      (progn
  90        (clsql:execute-command "create table foo (bar integer)")
  91        (clsql:table-exists-p [foo] :owner *test-database-user*))
  92      (progn
  93        (clsql:execute-command "drop table foo")
  94        (clsql:table-exists-p [foo] :owner *test-database-user*)))
  95   nil t nil)
  96
  97
  98 ;; compare min, max and average hieghts in inches (they're quite short
  99 ;; these guys!)
 100 (deftest :fdml/select/1
 101     (let ((max (clsql:select [function "floor"
 102                              [/ [* [max [height]] 100] 2.54]]
 103                              :from [employee]
 104                              :result-types nil
 105                              :flatp t))
 106           (min (clsql:select [function "floor"
 107                              [/ [* [min [height]] 100] 2.54]]
 108                              :from [employee]
 109                              :result-types nil
 110                              :flatp t))
 111           (avg (clsql:select [function "floor"
 112                              [avg [/ [* [height] 100] 2.54]]]
 113                              :from [employee]
 114                              :result-types nil
 115                              :flatp t)))
 116       (apply #'< (mapcar #'(lambda (s) (parse-integer s :junk-allowed t))
 117                          (append min avg max))))
 118  t)
 119
 120 (deftest :fdml/select/2
 121  (clsql:select [first-name] :from [employee] :flatp t :distinct t
 122                             :field-names nil
 123                             :result-types nil
 124                             :order-by [first-name])
 125  ("Boris" "Josef" "Konstantin" "Leon" "Leonid" "Mikhail" "Nikita" "Vladimir"
 126   "Yuri"))
 127
 128 (deftest :fdml/select/3
 129     (let ((res (clsql:select [first-name] [count [*]] :from [employee]
 130                              :result-types nil
 131                              :group-by [first-name]
 132                              :order-by [first-name]
 133                              :field-names nil)))
 134       (mapcar (lambda (p) (list (car p) (truncate (read-from-string (second p)))))
 135               res))
 136   (("Boris" 1) ("Josef" 1) ("Konstantin" 1) ("Leon" 1) ("Leonid" 1)
 137    ("Mikhail" 1) ("Nikita" 1) ("Vladimir" 2) ("Yuri" 1)))
 138
 139 (deftest :fdml/select/4
 140     (clsql:select [last-name] :from [employee]
 141                           :where [like [email] "%org"]
 142                           :order-by [last-name]
 143                           :field-names nil
 144                           :result-types nil
 145                           :flatp t)
 146  ("Andropov" "Brezhnev" "Chernenko" "Gorbachev" "Kruschev" "Lenin" "Putin"
 147   "Stalin" "Trotsky" "Yeltsin"))
 148
 149 (deftest :fdml/select/5
 150     (clsql:select [email] :from [employee] :flatp t :result-types nil
 151                           :where [in [employee emplid]
 152                           [select [managerid] :from [employee]]]
 153                           :field-names nil)
 154   ("lenin@soviet.org"))
 155
 156 (deftest :fdml/select/6
 157     (if (clsql-sys:db-type-has-fancy-math? *test-database-underlying-type*)
 158         (mapcar #'(lambda (s) (parse-integer s :junk-allowed t))
 159                 (clsql:select [function "trunc" [height]] :from [employee]
 160                               :result-types nil
 161                               :field-names nil
 162                               :flatp t))
 163         (mapcar #'(lambda (s) (truncate (parse-integer s :junk-allowed t)))
 164                 (clsql:select [height] :from [employee] :flatp t
 165                               :field-names nil :result-types nil)))
 166  (1 1 1 1 1 1 1 1 1 1))
 167
 168 (deftest :fdml/select/7
 169     (let ((result (car (clsql:select [max [emplid]] :from [employee] :flatp t
 170                                      :field-names nil :result-types nil))))
 171       (values
 172        (stringp result)
 173        (nth-value 0 (truncate (read-from-string result)))))
 174   t 10)
 175
 176 (deftest :fdml/select/8
 177     (let ((result (car (clsql:select [min [emplid]] :from [employee] :flatp t
 178                                      :field-names nil :result-types nil))))
 179       (values
 180        (stringp result)
 181        (nth-value 0 (truncate (read-from-string result)))))
 182   t 1)
 183
 184 (deftest :fdml/select/9
 185     (subseq
 186      (car
 187       (clsql:select [avg [emplid]] :from [employee] :flatp t
 188                     :field-names nil :result-types nil))
 189      0 3)
 190   "5.5")
 191
 192 (deftest :fdml/select/10
 193     (clsql:select [last-name] :from [employee]
 194                   :where [not [in [emplid]
 195                   [select [managerid] :from [company]]]]
 196                   :result-types nil
 197                   :field-names nil
 198                   :flatp t
 199                   :order-by [last-name])
 200  ("Andropov" "Brezhnev" "Chernenko" "Gorbachev" "Kruschev" "Putin" "Stalin"
 201   "Trotsky" "Yeltsin"))
 202
 203 (deftest :fdml/select/11
 204     (clsql:select [last-name] :from [employee] :where [married] :flatp t
 205                   :field-names nil :order-by [emplid] :result-types nil)
 206   ("Lenin" "Stalin" "Trotsky"))
 207
 208 (deftest :fdml/select/12
 209     (let ((v 1))
 210       (clsql:select [last-name] :from [employee] :where [= [emplid] v]
 211                     :field-names nil :result-types nil))
 212   (("Lenin")))
 213
 214 (deftest :fdml/select/13
 215      (multiple-value-bind (results field-names)
 216          (clsql:select [emplid] [last-name] :from [employee]
 217                        :where [= [emplid] 1])
 218        (values results (mapcar #'string-downcase field-names)))
 219  ((1 "Lenin"))
 220  ("emplid" "last_name"))
 221
 222 (deftest :fdml/select/14
 223      (floatp (car (clsql:select [height] :from [employee] :where [= [emplid] 1]
 224                                 :flatp t)))
 225   t)
 226
 227 (deftest :fdml/select/15
 228     (multiple-value-bind (rows field-names)
 229         (clsql:select [addressid] [street-number] [street-name] [city_field] [zip]
 230          :from [addr]
 231          :where [= 1 [addressid]])
 232       (values
 233        rows
 234        (mapcar #'string-downcase field-names)))
 235   ((1 10 "Park Place" "Leningrad" 123))
 236   ("addressid" "street_number" "street_name" "city_field" "zip"))
 237
 238 (deftest :fdml/select/16
 239     (clsql:select [emplid] :from [employee] :where [= 1 [emplid]]
 240      :field-names nil)
 241   ((1)))
 242
 243 (deftest :fdml/select/17
 244     (clsql:select [emplid] [last-name] :from [employee] :where [= 1 [emplid]]
 245      :field-names nil)
 246   ((1 "Lenin")))
 247
 248 (deftest :fdml/select/18
 249     (clsql:select [emplid :string] [last-name] :from [employee] :where [= 1 [emplid]]
 250      :field-names nil)
 251   (("1" "Lenin")))
 252
 253 (deftest :fdml/select/19
 254     (clsql:select [emplid] :from [employee] :order-by [emplid]
 255                            :where [between [* [emplid] 10] [* 5 10] [* 10 10]]
 256                            :field-names nil :result-types nil :flatp t)
 257  ("5" "6" "7" "8" "9" "10"))
 258
 259 (deftest :fdml/select/20
 260     (clsql:select [emplid] :from [employee] :order-by [emplid]
 261                            :where [not [between [* [emplid] 10] [* 5 10] [* 10 10]]]
 262                            :field-names nil :result-types nil :flatp t)
 263  ("1" "2" "3" "4"))
 264
 265 (deftest :fdml/select/21
 266   (clsql:select [substring [first-name] 1 4] :from [employee]
 267                 :flatp t :order-by [emplid] :field-names nil)
 268  ("Vlad" "Jose" "Leon" "Niki" "Leon" "Yuri" "Kons" "Mikh" "Bori" "Vlad"))
 269
 270 (deftest :fdml/select/22
 271    (case *test-database-underlying-type*
 272      (:mssql (clsql:select [+ [first-name] " " [last-name]] :from [employee]
 273                            :flatp t :order-by [emplid] :field-names nil))
 274      (t (clsql:select [|| [first-name] " " [last-name]] :from [employee]
 275                       :flatp t :order-by [emplid] :field-names nil)))
 276  ("Vladimir Lenin" "Josef Stalin" "Leon Trotsky" "Nikita Kruschev"
 277  "Leonid Brezhnev" "Yuri Andropov" "Konstantin Chernenko" "Mikhail Gorbachev"
 278  "Boris Yeltsin" "Vladimir Putin"))
 279
 280 (deftest :fdml/select/23
 281  (clsql:select [emplid] :from [employee] :where [in [emplid] '(1 2 3 4)]
 282                         :flatp t :order-by [emplid] :field-names nil
 283                         :result-types nil)
 284  ("1" "2" "3" "4"))
 285
 286 (deftest :fdml/select/24
 287  (clsql:select [distinct [first-name]] :from [employee] :flatp t
 288                :order-by [first-name] :field-names nil :result-types nil)
 289  ("Boris" "Josef" "Konstantin" "Leon" "Leonid" "Mikhail" "Nikita" "Vladimir"
 290   "Yuri"))
 291
 292 (deftest :fdml/select/25
 293  (clsql:select [first-name] :from (clsql-sys:convert-to-db-default-case "employee" *default-database*)
 294   :flatp t :distinct t
 295   :field-names nil
 296   :result-types nil
 297   :order-by [first-name])
 298  ("Boris" "Josef" "Konstantin" "Leon" "Leonid" "Mikhail" "Nikita" "Vladimir"
 299   "Yuri"))
 300
 301 (deftest :fdml/select/26
 302  (clsql:select ["table" first-name] ["table" last-name]
 303   :from '([employee "table"] [employee "join"])
 304   :where [and [= ["table" first-name]
 305                  ["join" first-name]]
 306               [not [= ["table" emplid]
 307                       ["join" emplid]]]]
 308   :order-by '(["table" last-name])
 309   :result-types nil :field-names nil)
 310  (("Vladimir" "Lenin") ("Vladimir" "Putin")))
 311
 312 (deftest :fdml/select/27
 313     (mapcar
 314      (lambda (f) (truncate (read-from-string f)))
 315      (clsql:select [coalesce [managerid] 10] :from [employee] :order-by [emplid]
 316                    :field-names nil :result-types nil :flatp t))
 317   (10 1 1 1 1 1 1 1 1 1))
 318
 319 (deftest :fdml/select/28
 320     (mapcar
 321      (lambda (f) (truncate (read-from-string (car f))))
 322      (loop for column in `([*] [emplid]) collect
 323            (clsql:select [count column] :from [employee]
 324                          :flatp t :result-types nil :field-names nil)))
 325  (10 10))
 326
 327 (deftest :fdml/select/29
 328  (clsql:select [first-name] [last-name] :from [employee]
 329                        :result-types nil :field-names nil
 330                        :order-by '(([first-name] :asc) ([last-name] :desc)))
 331  (("Boris" "Yeltsin") ("Josef" "Stalin") ("Konstantin" "Chernenko")
 332   ("Leon" "Trotsky") ("Leonid" "Brezhnev") ("Mikhail" "Gorbachev")
 333   ("Nikita" "Kruschev") ("Vladimir" "Putin") ("Vladimir" "Lenin")
 334   ("Yuri" "Andropov")))
 335
 336 (deftest :fdml/select/30
 337  (clsql:select [first-name] [last-name] :from [employee]
 338                        :result-types nil :field-names nil
 339                        :order-by '(([first-name] :asc) ([last-name] :asc)))
 340  (("Boris" "Yeltsin") ("Josef" "Stalin") ("Konstantin" "Chernenko")
 341   ("Leon" "Trotsky") ("Leonid" "Brezhnev") ("Mikhail" "Gorbachev")
 342   ("Nikita" "Kruschev") ("Vladimir" "Lenin") ("Vladimir" "Putin")
 343   ("Yuri" "Andropov")))
 344
 345 (deftest :fdml/select/31
 346  (clsql:select [last-name] :from [employee]
 347               :set-operation [union [select [first-name] :from [employee]
 348                                             :order-by [last-name]]]
 349               :flatp t
 350               :result-types nil
 351               :field-names nil)
 352  ("Andropov" "Boris" "Brezhnev" "Chernenko" "Gorbachev" "Josef" "Konstantin"
 353  "Kruschev" "Lenin" "Leon" "Leonid" "Mikhail" "Nikita" "Putin" "Stalin"
 354  "Trotsky" "Vladimir" "Yeltsin" "Yuri"))
 355
 356 (deftest :fdml/select/32
 357     (clsql:select [emplid] :from [employee]
 358                 :where [= [emplid] [any [select [companyid] :from [company]]]]
 359                 :flatp t :result-types nil :field-names nil)
 360   ("1"))
 361
 362 (deftest :fdml/select/33
 363  (clsql:select [last-name] :from [employee]
 364               :where [> [emplid] [all [select [groupid] :from [employee]]]]
 365               :order-by [last-name]
 366               :flatp t :result-types nil :field-names nil)
 367 ("Andropov" "Brezhnev" "Chernenko" "Gorbachev" "Kruschev" "Putin" "Stalin"
 368  "Trotsky" "Yeltsin"))
 369
 370 (deftest :fdml/select/34
 371   (loop for x from 1 below 5
 372    collect
 373    (car
 374     (clsql:select [last-name] :from [employee]
 375                   :where [= [emplid] x]
 376                   :flatp t :result-types nil :field-names nil)))
 377   ("Lenin" "Stalin" "Trotsky" "Kruschev"))
 378
 379 ;; test escaping of single quotes
 380 (deftest :fdml/select/35
 381     (clsql:select "What's up doc?" :from [employee] :flatp t :field-names nil)
 382   ("What's up doc?" "What's up doc?" "What's up doc?" "What's up doc?"
 383    "What's up doc?" "What's up doc?" "What's up doc?" "What's up doc?"
 384    "What's up doc?" "What's up doc?"))
 385
 386 ;; test proper treatment of backslash (depending on backend)
 387 (deftest :fdml/select/36
 388     (clsql:select "foo\\bar\\baz" :from [employee] :flatp t :field-names nil)
 389  ("foo\\bar\\baz" "foo\\bar\\baz" "foo\\bar\\baz" "foo\\bar\\baz"
 390   "foo\\bar\\baz"  "foo\\bar\\baz" "foo\\bar\\baz" "foo\\bar\\baz"
 391   "foo\\bar\\baz" "foo\\bar\\baz"))
 392
 393 (deftest :fdml/select/37
 394     (clsql:select [emplid] :from [employee]
 395                   :order-by [emplid]
 396                   :limit 5
 397                   :field-names nil
 398                   :flatp t)
 399   (1 2 3 4 5))
 400
 401 (deftest :fdml/select/38
 402     (clsql:select [emplid] :from [employee]
 403                   :order-by [emplid]
 404                   :limit 5
 405                   :offset 3
 406                   :field-names nil
 407                   :flatp t)
 408   (4 5 6 7 8))
 409
 410 (deftest :fdml/do-query/1
 411     (let ((result '()))
 412     (clsql:do-query ((name) [select [last-name] :from [employee]
 413                                    :order-by [last-name]])
 414       (push name result))
 415     result)
 416  ("Yeltsin" "Trotsky" "Stalin" "Putin" "Lenin" "Kruschev" "Gorbachev"
 417             "Chernenko" "Brezhnev" "Andropov"))
 418
 419 (deftest :fdml/map-query/1
 420     (clsql:map-query 'list #'identity
 421                     [select [last-name] :from [employee] :flatp t
 422                             :order-by [last-name]])
 423   ("Andropov" "Brezhnev" "Chernenko" "Gorbachev" "Kruschev" "Lenin" "Putin"
 424               "Stalin" "Trotsky" "Yeltsin"))
 425
 426 (deftest :fdml/map-query/2
 427     (clsql:map-query 'vector #'identity
 428                     [select [last-name] :from [employee] :flatp t
 429                             :order-by [last-name]])
 430   #("Andropov" "Brezhnev" "Chernenko" "Gorbachev" "Kruschev" "Lenin" "Putin"
 431     "Stalin" "Trotsky" "Yeltsin"))
 432
 433 (deftest :fdml/map-query/3
 434  (clsql:map-query 'list #'identity
 435                   [select [last-name] :from [employee] :order-by [last-name]])
 436  (("Andropov") ("Brezhnev") ("Chernenko") ("Gorbachev") ("Kruschev") ("Lenin")
 437   ("Putin") ("Stalin") ("Trotsky") ("Yeltsin")))
 438
 439 (deftest :fdml/map-query/4
 440  (clsql:map-query 'list #'identity
 441                   [select [first-name] [last-name] :from [employee]
 442                           :order-by [last-name]])
 443  (("Yuri" "Andropov") ("Leonid" "Brezhnev") ("Konstantin" "Chernenko")
 444   ("Mikhail" "Gorbachev") ("Nikita" "Kruschev") ("Vladimir" "Lenin")
 445   ("Vladimir" "Putin") ("Josef" "Stalin") ("Leon" "Trotsky")
 446   ("Boris" "Yeltsin")))
 447
 448 (deftest :fdml/loop/1
 449     (loop for (forename surname)
 450       being each tuple in
 451       [select [first-name] [last-name] :from [employee] :order-by [last-name]]
 452       collect (concatenate 'string forename " " surname))
 453   ("Yuri Andropov" "Leonid Brezhnev" "Konstantin Chernenko" "Mikhail Gorbachev"
 454                    "Nikita Kruschev" "Vladimir Lenin" "Vladimir Putin"
 455    "Josef Stalin" "Leon Trotsky" "Boris Yeltsin"))
 456
 457 (deftest :fdml/loop/2
 458     (loop for (addressid)
 459       being each tuple in
 460       [select [addressid] :from [addr] :order-by [addressid]]
 461      collect addressid)
 462   (1 2))
 463
 464 (deftest :fdml/loop/3
 465     (loop for addressid
 466       being each tuple in
 467       [select [addressid] :from [addr] :order-by [addressid]]
 468       collect addressid)
 469   (1 2))
 470
 471 ;; inserts a record using all values only and then deletes it
 472 (deftest :fdml/insert/1
 473     (let ((now (get-universal-time)))
 474       (clsql:insert-records :into [employee]
 475        :values `(11 1 "Yuri" "Gagarin" "gagarin@soviet.org"
 476                     1 1 1.85 t ,(clsql:utime->time now) ,now))
 477       (values
 478        (clsql:select [first-name] [last-name] [email]
 479                     :from [employee] :where [= [emplid] 11])
 480        (progn (clsql:delete-records :from [employee] :where [= [emplid] 11])
 481               (clsql:select [*] :from [employee] :where [= [emplid] 11]))))
 482   (("Yuri" "Gagarin" "gagarin@soviet.org")) nil)
 483
 484 ;; inserts a record using attributes and values and then deletes it
 485 (deftest :fdml/insert/2
 486     (progn
 487       (clsql:insert-records :into [employee]
 488                            :attributes '(emplid groupid first_name last_name
 489                                          email ecompanyid managerid)
 490                            :values '(11 1 "Yuri" "Gagarin" "gagarin@soviet.org"
 491                                      1 1))
 492       (values
 493        (clsql:select [first-name] [last-name] [email] :from [employee]
 494                     :where [= [emplid] 11])
 495        (progn (clsql:delete-records :from [employee] :where [= [emplid] 11])
 496               (clsql:select [*] :from [employee] :where [= [emplid] 11]))))
 497   (("Yuri" "Gagarin" "gagarin@soviet.org")) nil)
 498
 499 ;; inserts a record using av-pairs and then deletes it
 500 (deftest :fdml/insert/3
 501     (progn
 502       (clsql:insert-records :into [employee]
 503                            :av-pairs'((emplid 11) (groupid 1)
 504                                       (first_name "Yuri")
 505                                       (last_name "Gagarin")
 506                                       (email "gagarin@soviet.org")
 507                                       (ecompanyid 1) (managerid 1)))
 508       (values
 509        (clsql:select [first-name] [last-name] [email] :from [employee]
 510                     :where [= [emplid] 11])
 511        (progn (clsql:delete-records :from [employee] :where [= [emplid] 11])
 512               (clsql:select [first-name] [last-name] [email] :from [employee]
 513                            :where [= [emplid] 11]))))
 514   (("Yuri" "Gagarin" "gagarin@soviet.org")) nil)
 515
 516 ;; inserts a records using a query from another table
 517 (deftest :fdml/insert/4
 518     (progn
 519       (clsql:create-table [employee2] '(([forename] string)
 520                                  ([surname] string)
 521                                  ([email] string)))
 522       (clsql:insert-records :into [employee2]
 523                      :query [select [first-name] [last-name] [email]
 524                                     :from [employee]]
 525                      :attributes '(forename surname email))
 526       (prog1
 527           (equal (clsql:select [*] :from [employee2])
 528                  (clsql:select [first-name] [last-name] [email]
 529                               :from [employee]))
 530         (clsql:drop-table [employee2] :if-does-not-exist :ignore)))
 531   t)
 532
 533 ;; updates a record using attributes and values and then deletes it
 534 (deftest :fdml/update/1
 535     (progn
 536       (clsql:update-records [employee]
 537                            :attributes '(first_name last_name email)
 538                            :values '("Yuri" "Gagarin" "gagarin@soviet.org")
 539                            :where [= [emplid] 1])
 540       (values
 541        (clsql:select [first-name] [last-name] [email] :from [employee]
 542                     :where [= [emplid] 1])
 543        (progn
 544          (clsql:update-records [employee]
 545                               :av-pairs'((first_name "Vladimir")
 546                                          (last_name "Lenin")
 547                                          (email "lenin@soviet.org"))
 548                               :where [= [emplid] 1])
 549          (clsql:select [first-name] [last-name] [email] :from [employee]
 550                       :where [= [emplid] 1]))))
 551   (("Yuri" "Gagarin" "gagarin@soviet.org"))
 552   (("Vladimir" "Lenin" "lenin@soviet.org")))
 553
 554 ;; updates a record using av-pairs and then deletes it
 555 (deftest :fdml/update/2
 556     (progn
 557       (clsql:update-records [employee]
 558                            :av-pairs'((first_name "Yuri")
 559                                       (last_name "Gagarin")
 560                                       (email "gagarin@soviet.org"))
 561                            :where [= [emplid] 1])
 562       (values
 563        (clsql:select [first-name] [last-name] [email] :from [employee]
 564                     :where [= [emplid] 1])
 565        (progn
 566          (clsql:update-records [employee]
 567                               :av-pairs'((first_name "Vladimir")
 568                                          (last_name "Lenin")
 569                                          (email "lenin@soviet.org"))
 570                               :where [= [emplid] 1])
 571          (clsql:select [first-name] [last-name] [email]
 572                       :from [employee] :where [= [emplid] 1]))))
 573   (("Yuri" "Gagarin" "gagarin@soviet.org"))
 574   (("Vladimir" "Lenin" "lenin@soviet.org")))
 575
 576
 577
 578 ;; starts a transaction deletes a record and then rolls back the deletion
 579 (deftest :fdml/transaction/1
 580     (let ((results '()))
 581       ;; test if we are in a transaction
 582       (push (clsql:in-transaction-p) results)
 583       ;;start a transaction
 584       (clsql:start-transaction)
 585       ;; test if we are in a transaction
 586       (push (clsql:in-transaction-p) results)
 587       ;;Putin has got to go
 588       (clsql:delete-records :from [employee] :where [= [last-name] "Putin"])
 589       ;;Should be nil
 590       (push
 591        (clsql:select [*] :from [employee] :where [= [last-name] "Putin"])
 592        results)
 593       ;;Oh no, he's still there
 594       (clsql:rollback)
 595       ;; test that we are out of the transaction
 596       (push (clsql:in-transaction-p) results)
 597       ;; Check that we got him back alright
 598       (push (clsql:select [email] :from [employee] :where [= [last-name] "Putin"]
 599                          :flatp t)
 600             results)
 601       (apply #'values (nreverse results)))
 602   nil t nil nil ("putin@soviet.org"))
 603
 604 ;; starts a transaction, updates a record and then rolls back the update
 605 (deftest :fdml/transaction/2
 606     (let ((results '()))
 607       ;; test if we are in a transaction
 608       (push (clsql:in-transaction-p) results)
 609       ;;start a transaction
 610       (clsql:start-transaction)
 611       ;; test if we are in a transaction
 612       (push (clsql:in-transaction-p) results)
 613       ;;Putin has got to go
 614       (clsql:update-records [employee]
 615        :av-pairs '((email "putin-nospam@soviet.org"))
 616        :where [= [last-name] "Putin"])
 617       ;;Should be new value
 618       (push (clsql:select [email] :from [employee]
 619                          :where [= [last-name] "Putin"]
 620                          :flatp t)
 621             results)
 622       ;;Oh no, he's still there
 623       (clsql:rollback)
 624       ;; test that we are out of the transaction
 625       (push (clsql:in-transaction-p) results)
 626       ;; Check that we got him back alright
 627       (push (clsql:select [email] :from [employee] :where [= [last-name] "Putin"]
 628                          :flatp t)
 629             results)
 630       (apply #'values (nreverse results)))
 631   nil t ("putin-nospam@soviet.org") nil ("putin@soviet.org"))
 632
 633 ;; runs an update within a transaction and checks it is committed
 634 (deftest :fdml/transaction/3
 635     (let ((results '()))
 636       ;; check status
 637       (push (clsql:in-transaction-p) results)
 638       ;; update records
 639       (push
 640        (clsql:with-transaction ()
 641          (clsql:update-records [employee]
 642                               :av-pairs '((email "lenin-nospam@soviet.org"))
 643                               :where [= [emplid] 1]))
 644        results)
 645       ;; check status
 646       (push (clsql:in-transaction-p) results)
 647       ;; check that was committed
 648       (push (clsql:select [email] :from [employee] :where [= [emplid] 1]
 649                          :flatp t)
 650             results)
 651       ;; undo the changes
 652       (push
 653        (clsql:with-transaction ()
 654          (clsql:update-records [employee]
 655                               :av-pairs '((email "lenin@soviet.org"))
 656                               :where [= [emplid] 1]))
 657        results)
 658       ;; and check status
 659       (push (clsql:in-transaction-p) results)
 660       ;; check that was committed
 661       (push (clsql:select [email] :from [employee] :where [= [emplid] 1]
 662                          :flatp t)
 663             results)
 664       (apply #'values (nreverse results)))
 665   nil nil nil ("lenin-nospam@soviet.org") nil nil ("lenin@soviet.org"))
 666
 667 ;; runs a valid update and an invalid one within a transaction and checks
 668 ;; that the valid update is rolled back when the invalid one fails.
 669 (deftest :fdml/transaction/4
 670     (let ((results '()))
 671       ;; check status
 672       (push (clsql:in-transaction-p) results)
 673       (handler-case
 674           (clsql:with-transaction ()
 675             ;; valid update
 676             (clsql:update-records [employee]
 677                                   :av-pairs '((email "lenin-nospam@soviet.org"))
 678                                   :where [= [emplid] 1])
 679             ;; invalid update which generates an error
 680             (clsql:update-records [employee]
 681                                   :av-pairs
 682                                   '((emale "lenin-nospam@soviet.org"))
 683                                   :where [= [emplid] 1]))
 684         (clsql:sql-database-error ()
 685           (progn
 686             ;; check status
 687             (push (clsql:in-transaction-p) results)
 688             ;; and check nothing done
 689             (push (clsql:select [email] :from [employee] :where [= [emplid] 1]
 690                                :flatp t)
 691                   results)
 692             (apply #'values (nreverse results))))))
 693   nil nil ("lenin@soviet.org"))
 694
 695
 696 ))
 697
 698 #.(clsql:restore-sql-reader-syntax-state)