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