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 "Vladimir")
 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   (("Vladimir" "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 "Vladimir")
 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   (("Vladimir" "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") ("Vladimir" "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) ("Vladimir" 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" "Vladimir"
 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) ("Vladimir" 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    (case *test-database-underlying-type*
 377      (:mssql (clsql:select [+ [first-name] " " [last-name]] :from [employee]
 378                            :flatp t :order-by [emplid] :field-names nil))
 379      (t (clsql:select [|| [first-name] " " [last-name]] :from [employee]
 380                       :flatp t :order-by [emplid] :field-names nil)))
 381  ("Vladimir Lenin" "Josef Stalin" "Leon Trotsky" "Nikita Kruschev"
 382  "Leonid Brezhnev" "Yuri Andropov" "Konstantin Chernenko" "Mikhail Gorbachev"
 383  "Boris Yeltsin" "Vladimir Putin"))
 384
 385 (deftest :fdml/select/23
 386  (clsql:select [emplid] :from [employee] :where [in [emplid] '(1 2 3 4)]
 387                         :flatp t :order-by [emplid] :field-names nil
 388                         :result-types nil)
 389  ("1" "2" "3" "4"))
 390
 391 (deftest :fdml/select/24
 392  (clsql:select [distinct [first-name]] :from [employee] :flatp t
 393                :order-by [first-name] :field-names nil :result-types nil)
 394  ("Boris" "Josef" "Konstantin" "Leon" "Leonid" "Mikhail" "Nikita" "Vladimir"
 395   "Yuri"))
 396
 397 (deftest :fdml/select/25
 398  (clsql:select [first-name] :from (clsql-sys:convert-to-db-default-case "employee" *default-database*)
 399   :flatp t :distinct t
 400   :field-names nil
 401   :result-types nil
 402   :order-by [first-name])
 403  ("Boris" "Josef" "Konstantin" "Leon" "Leonid" "Mikhail" "Nikita" "Vladimir"
 404   "Yuri"))
 405
 406 (deftest :fdml/select/26
 407  (clsql:select ["table" first-name] ["table" last-name]
 408   :from '([employee "table"] [employee "join"])
 409   :where [and [= ["table" first-name]
 410                  ["join" first-name]]
 411               [not [= ["table" emplid]
 412                       ["join" emplid]]]]
 413   :order-by '(["table" last-name])
 414   :result-types nil :field-names nil)
 415  (("Vladimir" "Lenin") ("Vladimir" "Putin")))
 416
 417 (deftest :fdml/select/27
 418     (mapcar
 419      (lambda (f) (truncate (read-from-string f)))
 420      (clsql:select [coalesce [managerid] 10] :from [employee] :order-by [emplid]
 421                    :field-names nil :result-types nil :flatp t))
 422   (10 1 1 1 1 1 1 1 1 1))
 423
 424 (deftest :fdml/select/28
 425     (mapcar
 426      (lambda (f) (truncate (read-from-string (car f))))
 427      (loop for column in `([*] [emplid]) collect
 428            (clsql:select [count column] :from [employee]
 429                          :flatp t :result-types nil :field-names nil)))
 430  (10 10))
 431
 432 (deftest :fdml/select/29
 433  (clsql:select [first-name] [last-name] :from [employee]
 434                        :result-types nil :field-names nil
 435                        :order-by '(([first-name] :asc) ([last-name] :desc)))
 436  (("Boris" "Yeltsin") ("Josef" "Stalin") ("Konstantin" "Chernenko")
 437   ("Leon" "Trotsky") ("Leonid" "Brezhnev") ("Mikhail" "Gorbachev")
 438   ("Nikita" "Kruschev") ("Vladimir" "Putin") ("Vladimir" "Lenin")
 439   ("Yuri" "Andropov")))
 440
 441 (deftest :fdml/select/30
 442  (clsql:select [first-name] [last-name] :from [employee]
 443                        :result-types nil :field-names nil
 444                        :order-by '(([first-name] :asc) ([last-name] :asc)))
 445  (("Boris" "Yeltsin") ("Josef" "Stalin") ("Konstantin" "Chernenko")
 446   ("Leon" "Trotsky") ("Leonid" "Brezhnev") ("Mikhail" "Gorbachev")
 447   ("Nikita" "Kruschev") ("Vladimir" "Lenin") ("Vladimir" "Putin")
 448   ("Yuri" "Andropov")))
 449
 450 (deftest :fdml/select/31
 451  (clsql:select [last-name] :from [employee]
 452               :set-operation [union [select [first-name] :from [employee]
 453                                             :order-by [last-name]]]
 454               :flatp t
 455               :result-types nil
 456               :field-names nil)
 457  ("Andropov" "Boris" "Brezhnev" "Chernenko" "Gorbachev" "Josef" "Konstantin"
 458  "Kruschev" "Lenin" "Leon" "Leonid" "Mikhail" "Nikita" "Putin" "Stalin"
 459  "Trotsky" "Vladimir" "Yeltsin" "Yuri"))
 460
 461 (deftest :fdml/select/32
 462     (clsql:select [emplid] :from [employee]
 463                 :where [= [emplid] [any [select [companyid] :from [company]]]]
 464                 :flatp t :result-types nil :field-names nil)
 465   ("1"))
 466
 467 (deftest :fdml/select/33
 468  (clsql:select [last-name] :from [employee]
 469               :where [> [emplid] [all [select [groupid] :from [employee]]]]
 470               :order-by [last-name]
 471               :flatp t :result-types nil :field-names nil)
 472 ("Andropov" "Brezhnev" "Chernenko" "Gorbachev" "Kruschev" "Putin" "Stalin"
 473  "Trotsky" "Yeltsin"))
 474
 475 (deftest :fdml/select/34
 476   (loop for x from 1 below 5
 477    collect
 478    (car
 479     (clsql:select [last-name] :from [employee]
 480                   :where [= [emplid] x]
 481                   :flatp t :result-types nil :field-names nil)))
 482   ("Lenin" "Stalin" "Trotsky" "Kruschev"))
 483
 484 ;; test escaping of single quotes
 485 (deftest :fdml/select/35
 486     (clsql:select "What's up doc?" :from [employee] :flatp t :field-names nil)
 487   ("What's up doc?" "What's up doc?" "What's up doc?" "What's up doc?"
 488    "What's up doc?" "What's up doc?" "What's up doc?" "What's up doc?"
 489    "What's up doc?" "What's up doc?"))
 490
 491 ;; test proper treatment of backslash (depending on backend)
 492 (deftest :fdml/select/36
 493     (clsql:select "foo\\bar\\baz" :from [employee] :flatp t :field-names nil)
 494  ("foo\\bar\\baz" "foo\\bar\\baz" "foo\\bar\\baz" "foo\\bar\\baz"
 495   "foo\\bar\\baz"  "foo\\bar\\baz" "foo\\bar\\baz" "foo\\bar\\baz"
 496   "foo\\bar\\baz" "foo\\bar\\baz"))
 497
 498 (deftest :fdml/do-query/1
 499     (let ((result '()))
 500     (clsql:do-query ((name) [select [last-name] :from [employee]
 501                                    :order-by [last-name]])
 502       (push name result))
 503     result)
 504  ("Yeltsin" "Trotsky" "Stalin" "Putin" "Lenin" "Kruschev" "Gorbachev"
 505             "Chernenko" "Brezhnev" "Andropov"))
 506
 507 (deftest :fdml/map-query/1
 508     (clsql:map-query 'list #'identity
 509                     [select [last-name] :from [employee] :flatp t
 510                             :order-by [last-name]])
 511   ("Andropov" "Brezhnev" "Chernenko" "Gorbachev" "Kruschev" "Lenin" "Putin"
 512               "Stalin" "Trotsky" "Yeltsin"))
 513
 514 (deftest :fdml/map-query/2
 515     (clsql:map-query 'vector #'identity
 516                     [select [last-name] :from [employee] :flatp t
 517                             :order-by [last-name]])
 518   #("Andropov" "Brezhnev" "Chernenko" "Gorbachev" "Kruschev" "Lenin" "Putin"
 519     "Stalin" "Trotsky" "Yeltsin"))
 520
 521 (deftest :fdml/map-query/3
 522  (clsql:map-query 'list #'identity
 523                   [select [last-name] :from [employee] :order-by [last-name]])
 524  (("Andropov") ("Brezhnev") ("Chernenko") ("Gorbachev") ("Kruschev") ("Lenin")
 525   ("Putin") ("Stalin") ("Trotsky") ("Yeltsin")))
 526
 527 (deftest :fdml/map-query/4
 528  (clsql:map-query 'list #'identity
 529                   [select [first-name] [last-name] :from [employee]
 530                           :order-by [last-name]])
 531  (("Yuri" "Andropov") ("Leonid" "Brezhnev") ("Konstantin" "Chernenko")
 532   ("Mikhail" "Gorbachev") ("Nikita" "Kruschev") ("Vladimir" "Lenin")
 533   ("Vladimir" "Putin") ("Josef" "Stalin") ("Leon" "Trotsky")
 534   ("Boris" "Yeltsin")))
 535
 536 (deftest :fdml/loop/1
 537     (loop for (forename surname)
 538       being each tuple in
 539       [select [first-name] [last-name] :from [employee] :order-by [last-name]]
 540       collect (concatenate 'string forename " " surname))
 541   ("Yuri Andropov" "Leonid Brezhnev" "Konstantin Chernenko" "Mikhail Gorbachev"
 542                    "Nikita Kruschev" "Vladimir Lenin" "Vladimir Putin"
 543    "Josef Stalin" "Leon Trotsky" "Boris Yeltsin"))
 544
 545 (deftest :fdml/loop/2
 546     (loop for (addressid)
 547       being each tuple in
 548       [select [addressid] :from [addr] :order-by [addressid]]
 549      collect addressid)
 550   (1 2))
 551
 552 (deftest :fdml/loop/3
 553     (loop for addressid
 554       being each tuple in
 555       [select [addressid] :from [addr] :order-by [addressid]]
 556       collect addressid)
 557   (1 2))
 558
 559 ;; starts a transaction deletes a record and then rolls back the deletion
 560 (deftest :fdml/transaction/1
 561     (let ((results '()))
 562       ;; test if we are in a transaction
 563       (push (clsql:in-transaction-p) results)
 564       ;;start a transaction
 565       (clsql:start-transaction)
 566       ;; test if we are in a transaction
 567       (push (clsql:in-transaction-p) results)
 568       ;;Putin has got to go
 569       (clsql:delete-records :from [employee] :where [= [last-name] "Putin"])
 570       ;;Should be nil
 571       (push
 572        (clsql:select [*] :from [employee] :where [= [last-name] "Putin"])
 573        results)
 574       ;;Oh no, he's still there
 575       (clsql:rollback)
 576       ;; test that we are out of the transaction
 577       (push (clsql:in-transaction-p) results)
 578       ;; Check that we got him back alright
 579       (push (clsql:select [email] :from [employee] :where [= [last-name] "Putin"]
 580                          :flatp t)
 581             results)
 582       (apply #'values (nreverse results)))
 583   nil t nil nil ("putin@soviet.org"))
 584
 585 ;; starts a transaction, updates a record and then rolls back the update
 586 (deftest :fdml/transaction/2
 587     (let ((results '()))
 588       ;; test if we are in a transaction
 589       (push (clsql:in-transaction-p) results)
 590       ;;start a transaction
 591       (clsql:start-transaction)
 592       ;; test if we are in a transaction
 593       (push (clsql:in-transaction-p) results)
 594       ;;Putin has got to go
 595       (clsql:update-records [employee]
 596        :av-pairs '((email "putin-nospam@soviet.org"))
 597        :where [= [last-name] "Putin"])
 598       ;;Should be new value
 599       (push (clsql:select [email] :from [employee]
 600                          :where [= [last-name] "Putin"]
 601                          :flatp t)
 602             results)
 603       ;;Oh no, he's still there
 604       (clsql:rollback)
 605       ;; test that we are out of the transaction
 606       (push (clsql:in-transaction-p) results)
 607       ;; Check that we got him back alright
 608       (push (clsql:select [email] :from [employee] :where [= [last-name] "Putin"]
 609                          :flatp t)
 610             results)
 611       (apply #'values (nreverse results)))
 612   nil t ("putin-nospam@soviet.org") nil ("putin@soviet.org"))
 613
 614 ;; runs an update within a transaction and checks it is committed
 615 (deftest :fdml/transaction/3
 616     (let ((results '()))
 617       ;; check status
 618       (push (clsql:in-transaction-p) results)
 619       ;; update records
 620       (push
 621        (clsql:with-transaction ()
 622          (clsql:update-records [employee]
 623                               :av-pairs '((email "lenin-nospam@soviet.org"))
 624                               :where [= [emplid] 1]))
 625        results)
 626       ;; check status
 627       (push (clsql:in-transaction-p) results)
 628       ;; check that was committed
 629       (push (clsql:select [email] :from [employee] :where [= [emplid] 1]
 630                          :flatp t)
 631             results)
 632       ;; undo the changes
 633       (push
 634        (clsql:with-transaction ()
 635          (clsql:update-records [employee]
 636                               :av-pairs '((email "lenin@soviet.org"))
 637                               :where [= [emplid] 1]))
 638        results)
 639       ;; and check status
 640       (push (clsql:in-transaction-p) results)
 641       ;; check that was committed
 642       (push (clsql:select [email] :from [employee] :where [= [emplid] 1]
 643                          :flatp t)
 644             results)
 645       (apply #'values (nreverse results)))
 646   nil nil nil ("lenin-nospam@soviet.org") nil nil ("lenin@soviet.org"))
 647
 648 ;; runs a valid update and an invalid one within a transaction and checks
 649 ;; that the valid update is rolled back when the invalid one fails.
 650 (deftest :fdml/transaction/4
 651     (let ((results '()))
 652       ;; check status
 653       (push (clsql:in-transaction-p) results)
 654       (handler-case
 655           (clsql:with-transaction ()
 656             ;; valid update
 657             (clsql:update-records [employee]
 658                                   :av-pairs '((email "lenin-nospam@soviet.org"))
 659                                   :where [= [emplid] 1])
 660             ;; invalid update which generates an error
 661             (clsql:update-records [employee]
 662                                   :av-pairs
 663                                   '((emale "lenin-nospam@soviet.org"))
 664                                   :where [= [emplid] 1]))
 665         (clsql:sql-database-error ()
 666           (progn
 667             ;; check status
 668             (push (clsql:in-transaction-p) results)
 669             ;; and check nothing done
 670             (push (clsql:select [email] :from [employee] :where [= [emplid] 1]
 671                                :flatp t)
 672                   results)
 673             (apply #'values (nreverse results))))))
 674   nil nil ("lenin@soviet.org"))
 675
 676
 677 ))
 678
 679 #.(clsql:restore-sql-reader-syntax-state)