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