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