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