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