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/select/37
 499     (clsql:select [emplid] :from [employee]
 500                   :order-by [emplid]
 501                   :limit 5
 502                   :field-names nil
 503                   :flatp t)
 504   (1 2 3 4 5))
 505
 506 (deftest :fdml/select/38
 507     (clsql:select [emplid] :from [employee]
 508                   :order-by [emplid]
 509                   :limit 5
 510                   :offset 3
 511                   :field-names nil
 512                   :flatp t)
 513   (4 5 6 7 8))
 514
 515 (deftest :fdml/do-query/1
 516     (let ((result '()))
 517     (clsql:do-query ((name) [select [last-name] :from [employee]
 518                                    :order-by [last-name]])
 519       (push name result))
 520     result)
 521  ("Yeltsin" "Trotsky" "Stalin" "Putin" "Lenin" "Kruschev" "Gorbachev"
 522             "Chernenko" "Brezhnev" "Andropov"))
 523
 524 (deftest :fdml/map-query/1
 525     (clsql:map-query 'list #'identity
 526                     [select [last-name] :from [employee] :flatp t
 527                             :order-by [last-name]])
 528   ("Andropov" "Brezhnev" "Chernenko" "Gorbachev" "Kruschev" "Lenin" "Putin"
 529               "Stalin" "Trotsky" "Yeltsin"))
 530
 531 (deftest :fdml/map-query/2
 532     (clsql:map-query 'vector #'identity
 533                     [select [last-name] :from [employee] :flatp t
 534                             :order-by [last-name]])
 535   #("Andropov" "Brezhnev" "Chernenko" "Gorbachev" "Kruschev" "Lenin" "Putin"
 536     "Stalin" "Trotsky" "Yeltsin"))
 537
 538 (deftest :fdml/map-query/3
 539  (clsql:map-query 'list #'identity
 540                   [select [last-name] :from [employee] :order-by [last-name]])
 541  (("Andropov") ("Brezhnev") ("Chernenko") ("Gorbachev") ("Kruschev") ("Lenin")
 542   ("Putin") ("Stalin") ("Trotsky") ("Yeltsin")))
 543
 544 (deftest :fdml/map-query/4
 545  (clsql:map-query 'list #'identity
 546                   [select [first-name] [last-name] :from [employee]
 547                           :order-by [last-name]])
 548  (("Yuri" "Andropov") ("Leonid" "Brezhnev") ("Konstantin" "Chernenko")
 549   ("Mikhail" "Gorbachev") ("Nikita" "Kruschev") ("Vladimir" "Lenin")
 550   ("Vladimir" "Putin") ("Josef" "Stalin") ("Leon" "Trotsky")
 551   ("Boris" "Yeltsin")))
 552
 553 (deftest :fdml/loop/1
 554     (loop for (forename surname)
 555       being each tuple in
 556       [select [first-name] [last-name] :from [employee] :order-by [last-name]]
 557       collect (concatenate 'string forename " " surname))
 558   ("Yuri Andropov" "Leonid Brezhnev" "Konstantin Chernenko" "Mikhail Gorbachev"
 559                    "Nikita Kruschev" "Vladimir Lenin" "Vladimir Putin"
 560    "Josef Stalin" "Leon Trotsky" "Boris Yeltsin"))
 561
 562 (deftest :fdml/loop/2
 563     (loop for (addressid)
 564       being each tuple in
 565       [select [addressid] :from [addr] :order-by [addressid]]
 566      collect addressid)
 567   (1 2))
 568
 569 (deftest :fdml/loop/3
 570     (loop for addressid
 571       being each tuple in
 572       [select [addressid] :from [addr] :order-by [addressid]]
 573       collect addressid)
 574   (1 2))
 575
 576 ;; starts a transaction deletes a record and then rolls back the deletion
 577 (deftest :fdml/transaction/1
 578     (let ((results '()))
 579       ;; test if we are in a transaction
 580       (push (clsql:in-transaction-p) results)
 581       ;;start a transaction
 582       (clsql:start-transaction)
 583       ;; test if we are in a transaction
 584       (push (clsql:in-transaction-p) results)
 585       ;;Putin has got to go
 586       (clsql:delete-records :from [employee] :where [= [last-name] "Putin"])
 587       ;;Should be nil
 588       (push
 589        (clsql:select [*] :from [employee] :where [= [last-name] "Putin"])
 590        results)
 591       ;;Oh no, he's still there
 592       (clsql:rollback)
 593       ;; test that we are out of the transaction
 594       (push (clsql:in-transaction-p) results)
 595       ;; Check that we got him back alright
 596       (push (clsql:select [email] :from [employee] :where [= [last-name] "Putin"]
 597                          :flatp t)
 598             results)
 599       (apply #'values (nreverse results)))
 600   nil t nil nil ("putin@soviet.org"))
 601
 602 ;; starts a transaction, updates a record and then rolls back the update
 603 (deftest :fdml/transaction/2
 604     (let ((results '()))
 605       ;; test if we are in a transaction
 606       (push (clsql:in-transaction-p) results)
 607       ;;start a transaction
 608       (clsql:start-transaction)
 609       ;; test if we are in a transaction
 610       (push (clsql:in-transaction-p) results)
 611       ;;Putin has got to go
 612       (clsql:update-records [employee]
 613        :av-pairs '((email "putin-nospam@soviet.org"))
 614        :where [= [last-name] "Putin"])
 615       ;;Should be new value
 616       (push (clsql:select [email] :from [employee]
 617                          :where [= [last-name] "Putin"]
 618                          :flatp t)
 619             results)
 620       ;;Oh no, he's still there
 621       (clsql:rollback)
 622       ;; test that we are out of the transaction
 623       (push (clsql:in-transaction-p) results)
 624       ;; Check that we got him back alright
 625       (push (clsql:select [email] :from [employee] :where [= [last-name] "Putin"]
 626                          :flatp t)
 627             results)
 628       (apply #'values (nreverse results)))
 629   nil t ("putin-nospam@soviet.org") nil ("putin@soviet.org"))
 630
 631 ;; runs an update within a transaction and checks it is committed
 632 (deftest :fdml/transaction/3
 633     (let ((results '()))
 634       ;; check status
 635       (push (clsql:in-transaction-p) results)
 636       ;; update records
 637       (push
 638        (clsql:with-transaction ()
 639          (clsql:update-records [employee]
 640                               :av-pairs '((email "lenin-nospam@soviet.org"))
 641                               :where [= [emplid] 1]))
 642        results)
 643       ;; check status
 644       (push (clsql:in-transaction-p) results)
 645       ;; check that was committed
 646       (push (clsql:select [email] :from [employee] :where [= [emplid] 1]
 647                          :flatp t)
 648             results)
 649       ;; undo the changes
 650       (push
 651        (clsql:with-transaction ()
 652          (clsql:update-records [employee]
 653                               :av-pairs '((email "lenin@soviet.org"))
 654                               :where [= [emplid] 1]))
 655        results)
 656       ;; and check status
 657       (push (clsql:in-transaction-p) results)
 658       ;; check that was committed
 659       (push (clsql:select [email] :from [employee] :where [= [emplid] 1]
 660                          :flatp t)
 661             results)
 662       (apply #'values (nreverse results)))
 663   nil nil nil ("lenin-nospam@soviet.org") nil nil ("lenin@soviet.org"))
 664
 665 ;; runs a valid update and an invalid one within a transaction and checks
 666 ;; that the valid update is rolled back when the invalid one fails.
 667 (deftest :fdml/transaction/4
 668     (let ((results '()))
 669       ;; check status
 670       (push (clsql:in-transaction-p) results)
 671       (handler-case
 672           (clsql:with-transaction ()
 673             ;; valid update
 674             (clsql:update-records [employee]
 675                                   :av-pairs '((email "lenin-nospam@soviet.org"))
 676                                   :where [= [emplid] 1])
 677             ;; invalid update which generates an error
 678             (clsql:update-records [employee]
 679                                   :av-pairs
 680                                   '((emale "lenin-nospam@soviet.org"))
 681                                   :where [= [emplid] 1]))
 682         (clsql:sql-database-error ()
 683           (progn
 684             ;; check status
 685             (push (clsql:in-transaction-p) results)
 686             ;; and check nothing done
 687             (push (clsql:select [email] :from [employee] :where [= [emplid] 1]
 688                                :flatp t)
 689                   results)
 690             (apply #'values (nreverse results))))))
 691   nil nil ("lenin@soviet.org"))
 692
 693
 694 ))
 695
 696 #.(clsql:restore-sql-reader-syntax-state)