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