tests/test-fdml.lisp

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