tests/test-oodml.lisp

   1 ;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
   2 ;;;; ======================================================================
   3 ;;;; File:    test-oodml.lisp
   4 ;;;; Author:  Marcus Pearce <m.t.pearce@city.ac.uk>
   5 ;;;; Created: 01/04/2004
   6 ;;;;
   7 ;;;; Tests for the CLSQL Object Oriented Data Definition Language
   8 ;;;; (OODML).
   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 (setq *rt-oodml*
  22       '(
  23
  24         (deftest :oodml/select/1
  25             (mapcar #'(lambda (e) (slot-value e 'last-name))
  26              (clsql:select 'employee :order-by [last-name] :flatp t :caching nil))
  27           ("Andropov" "Brezhnev" "Chernenko" "Gorbachev" "Kruschev" "Lenin" "Putin"
  28            "Stalin" "Trotsky" "Yeltsin"))
  29
  30         (deftest :oodml/select/2
  31             (mapcar #'(lambda (e) (slot-value e 'name))
  32              (clsql:select 'company :flatp t :caching nil))
  33           ("Widgets Inc."))
  34
  35         (deftest :oodml/select/3
  36             (mapcar #'(lambda (e) (slot-value e 'ecompanyid))
  37              (clsql:select 'employee
  38                            :where [and [= [slot-value 'employee 'ecompanyid]
  39                                           [slot-value 'company 'companyid]]
  40                                        [= [slot-value 'company 'name]
  41                                           "Widgets Inc."]]
  42                            :flatp t
  43                            :caching nil))
  44           (1 1 1 1 1 1 1 1 1 1))
  45
  46         (deftest :oodml/select/4
  47             (mapcar #'(lambda (e)
  48                         (concatenate 'string (slot-value e 'first-name)
  49                                      " "
  50                                      (slot-value e 'last-name)))
  51              (clsql:select 'employee :where [= [slot-value 'employee 'first-name]
  52                                                "Vladimir"]
  53                            :flatp t
  54                            :order-by [last-name]
  55                            :caching nil))
  56           ("Vladimir Lenin" "Vladimir Putin"))
  57
  58         (deftest :oodml/select/5
  59             (length (clsql:select 'employee :where [married] :flatp t :caching nil))
  60           3)
  61
  62         (deftest :oodml/select/6
  63             (let ((a (caar (clsql:select 'address :where [= 1 [addressid]] :caching nil))))
  64               (values
  65                (slot-value a 'street-number)
  66                (slot-value a 'street-name)
  67                (slot-value a 'city)
  68                (slot-value a 'postal-code)))
  69           10 "Park Place" "Leningrad" 123)
  70
  71         (deftest :oodml/select/7
  72             (let ((a (caar (clsql:select 'address :where [= 2 [addressid]] :caching nil))))
  73               (values
  74                (slot-value a 'street-number)
  75                (slot-value a 'street-name)
  76                (slot-value a 'city)
  77                (slot-value a 'postal-code)))
  78           nil "" "no city" 0)
  79
  80         (deftest :oodml/select/8
  81             (mapcar #'(lambda (e) (slot-value e 'married))
  82              (clsql:select 'employee :flatp t :order-by [emplid] :caching nil))
  83           (t t t nil nil nil nil nil nil nil))
  84
  85         (deftest :oodml/select/9
  86             (mapcar #'(lambda (pair)
  87                         (list
  88                          (typep (car pair) 'address)
  89                          (typep (second pair) 'employee-address)
  90                          (slot-value (car pair) 'addressid)
  91                          (slot-value (second pair) 'aaddressid)
  92                          (slot-value (second pair) 'aemplid)))
  93              (employee-addresses employee1))
  94           ((t t 1 1 1) (t t 2 2 1)))
  95
  96         (deftest :oodml/select/10
  97             (mapcar #'(lambda (pair)
  98                         (list
  99                          (typep (car pair) 'address)
 100                          (typep (second pair) 'employee-address)
 101                          (slot-value (car pair) 'addressid)
 102                          (slot-value (second pair) 'aaddressid)
 103                          (slot-value (second pair) 'aemplid)))
 104              (employee-addresses employee2))
 105           ((t t 2 2 2)))
 106
 107         (deftest :oodml/select/11
 108          (values (mapcar #'(lambda (x) (slot-value x 'emplid))
 109                          (clsql:select 'employee :order-by '(([emplid] :asc))
 110                                        :flatp t))
 111           (mapcar #'(lambda (x) (slot-value x 'emplid))
 112            (clsql:select 'employee :order-by '(([emplid] :desc))
 113                          :flatp t)))
 114          (1 2 3 4 5 6 7 8 9 10)
 115          (10 9 8 7 6 5 4 3 2 1))
 116
 117         ;; test retrieval of node, derived nodes etc
 118         (deftest :oodml/select/12
 119             (length (clsql:select 'node :where [node-id] :flatp t :caching nil))
 120           11)
 121
 122         (deftest :oodml/select/13
 123             (let ((a (car (clsql:select 'node :where [= 1 [node-id]] :flatp t :caching nil))))
 124               (values
 125                (slot-value a 'node-id)
 126                (slot-value a 'title)))
 127           1 "Bare node")
 128
 129         (deftest :oodml/select/14
 130             (length (clsql:select 'setting :where [setting-id] :flatp t :caching nil))
 131           4)
 132
 133         (deftest :oodml/select/15
 134             (let ((a (car (clsql:select 'setting :where [= 3 [setting-id]] :flatp t :caching nil))))
 135               (values
 136                (slot-value a 'node-id)
 137                (slot-value a 'setting-id)
 138                (slot-value a 'title)
 139                (slot-value a 'vars)))
 140           3 3 "Setting2" "var 2")
 141
 142         (deftest :oodml/select/16
 143             (length (clsql:select 'user :where [user-id] :flatp t :caching nil))
 144           2)
 145
 146         (deftest :oodml/select/17
 147             (let ((a (car (clsql:select 'user :where [= 4 [user-id]] :flatp t :caching nil))))
 148               (values
 149                (slot-value a 'node-id)
 150                (slot-value a 'user-id)
 151                (slot-value a 'title)
 152                (slot-value a 'nick)))
 153           4 4 "user-1" "first user")
 154
 155         (deftest :oodml/select/18
 156             (length (clsql:select 'theme :where [theme-id] :flatp t :caching nil))
 157           2)
 158
 159         (deftest :oodml/select/19
 160          (let ((a (car (clsql:select 'theme :where [= 6 [theme-id]] :flatp t :caching nil))))
 161            (slot-value a 'theme-id))
 162          6)
 163
 164         (deftest :oodml/select/20
 165             (let ((a (car (clsql:select 'theme :where [= 7 [theme-id]] :flatp t :caching nil))))
 166               (values
 167                (slot-value a 'node-id)
 168                (slot-value a 'theme-id)
 169                (slot-value a 'title)
 170                (slot-value a 'vars)
 171                (slot-value a 'doc)
 172                ))
 173          7 7 "theme-2"
 174          nil "second theme")
 175
 176                 ;; Some tests to check weird subclassed nodes (node without own table, or subclassed of same)
 177         (deftest :oodml/select/21
 178             (let ((a (car (clsql:select 'location :where [= [title] "location-1"] :flatp t :caching nil))))
 179               (values
 180                (slot-value a 'node-id)
 181                (slot-value a 'title)))
 182           8 "location-1")
 183
 184         (deftest :oodml/select/22
 185             (let ((a (car (clsql:select 'subloc :where [subloc-id] :flatp t :caching nil))))
 186               (values
 187                (slot-value a 'node-id)
 188                (slot-value a 'subloc-id)
 189                (slot-value a 'title)
 190                (slot-value a 'loc)))
 191           10 10 "subloc-1" "a subloc")
 192
 193         ;; test retrieval is deferred
 194         (deftest :oodm/retrieval/1
 195             (every #'(lambda (e) (not (slot-boundp e 'company)))
 196              (select 'employee :flatp t :caching nil))
 197           t)
 198
 199         (deftest :oodm/retrieval/2
 200             (every #'(lambda (e) (not (slot-boundp e 'address)))
 201              (select 'deferred-employee-address :flatp t :caching nil))
 202           t)
 203
 204         ;; :retrieval :immediate should be boundp before accessed
 205         (deftest :oodm/retrieval/3
 206             (every #'(lambda (ea) (slot-boundp ea 'address))
 207              (select 'employee-address :flatp t :caching nil))
 208           t)
 209
 210         (deftest :oodm/retrieval/4
 211             (mapcar #'(lambda (ea) (typep (slot-value ea 'address) 'address))
 212              (select 'employee-address :flatp t :caching nil))
 213           (t t t t t))
 214
 215         (deftest :oodm/retrieval/5
 216             (mapcar #'(lambda (ea) (typep (slot-value ea 'address) 'address))
 217              (select 'deferred-employee-address :flatp t :caching nil))
 218           (t t t t t))
 219
 220         (deftest :oodm/retrieval/6
 221             (every #'(lambda (ea) (slot-boundp (slot-value ea 'address) 'addressid))
 222              (select 'employee-address :flatp t :caching nil))
 223           t)
 224
 225         (deftest :oodm/retrieval/7
 226             (every #'(lambda (ea) (slot-boundp (slot-value ea 'address) 'addressid))
 227              (select 'deferred-employee-address :flatp t :caching nil))
 228           t)
 229
 230         (deftest :oodm/retrieval/8
 231             (mapcar #'(lambda (ea) (slot-value (slot-value ea 'address) 'street-number))
 232              (select 'employee-address :flatp t :order-by [aaddressid] :caching nil))
 233           (10 10 nil nil nil))
 234
 235         (deftest :oodm/retrieval/9
 236             (mapcar #'(lambda (ea) (slot-value (slot-value ea 'address) 'street-number))
 237              (select 'deferred-employee-address :flatp t :order-by [aaddressid] :caching nil))
 238           (10 10 nil nil nil))
 239
 240         ;; tests update-records-from-instance
 241         (deftest :oodml/update-records/1
 242             (values
 243              (progn
 244                (let ((lenin (car (clsql:select 'employee
 245                                                :where [= [slot-value 'employee 'emplid]
 246                                                          1]
 247                                                :flatp t
 248                                                :caching nil))))
 249                  (concatenate 'string
 250                               (first-name lenin)
 251                               " "
 252                               (last-name lenin)
 253                               ": "
 254                               (employee-email lenin))))
 255              (progn
 256                (setf (slot-value employee1 'first-name) "Dimitriy"
 257                      (slot-value employee1 'last-name) "Ivanovich"
 258                      (slot-value employee1 'email) "ivanovich@soviet.org")
 259                (clsql:update-records-from-instance employee1)
 260                (let ((lenin (car (clsql:select 'employee
 261                                                :where [= [slot-value 'employee 'emplid]
 262                                                          1]
 263                                                :flatp t
 264                                                :caching nil))))
 265                  (concatenate 'string
 266                               (first-name lenin)
 267                               " "
 268                               (last-name lenin)
 269                               ": "
 270                               (employee-email lenin))))
 271              (progn
 272                (setf (slot-value employee1 'first-name) "Vladimir"
 273                      (slot-value employee1 'last-name) "Lenin"
 274                      (slot-value employee1 'email) "lenin@soviet.org")
 275                (clsql:update-records-from-instance employee1)
 276                (let ((lenin (car (clsql:select 'employee
 277                                                :where [= [slot-value 'employee 'emplid]
 278                                                          1]
 279                                                :flatp t
 280                                                :caching nil))))
 281                  (concatenate 'string
 282                               (first-name lenin)
 283                               " "
 284                               (last-name lenin)
 285                               ": "
 286                               (employee-email lenin)))))
 287           "Vladimir Lenin: lenin@soviet.org"
 288           "Dimitriy Ivanovich: ivanovich@soviet.org"
 289           "Vladimir Lenin: lenin@soviet.org")
 290
 291         ;; tests update-record-from-slot
 292         (deftest :oodml/update-records/2
 293             (values
 294              (employee-email
 295               (car (clsql:select 'employee
 296                                  :where [= [slot-value 'employee 'emplid] 1]
 297                                  :flatp t
 298                                  :caching nil)))
 299              (progn
 300                (setf (slot-value employee1 'email) "lenin-nospam@soviet.org")
 301                (clsql:update-record-from-slot employee1 'email)
 302                (employee-email
 303                 (car (clsql:select 'employee
 304                                    :where [= [slot-value 'employee 'emplid] 1]
 305                                    :flatp t
 306                                    :caching nil))))
 307              (progn
 308                (setf (slot-value employee1 'email) "lenin@soviet.org")
 309                (clsql:update-record-from-slot employee1 'email)
 310                (employee-email
 311                 (car (clsql:select 'employee
 312                                    :where [= [slot-value 'employee 'emplid] 1]
 313                                    :flatp t
 314                                    :caching nil)))))
 315           "lenin@soviet.org" "lenin-nospam@soviet.org" "lenin@soviet.org")
 316
 317         ;; tests update-record-from-slots
 318         (deftest :oodml/update-records/3
 319             (values
 320              (let ((lenin (car (clsql:select 'employee
 321                                              :where [= [slot-value 'employee 'emplid]
 322                                                        1]
 323                                              :flatp t
 324                                              :caching nil))))
 325                (concatenate 'string
 326                             (first-name lenin)
 327                             " "
 328                             (last-name lenin)
 329                             ": "
 330                             (employee-email lenin)))
 331              (progn
 332                (setf (slot-value employee1 'first-name) "Dimitriy"
 333                      (slot-value employee1 'last-name) "Ivanovich"
 334                      (slot-value employee1 'email) "ivanovich@soviet.org")
 335                (clsql:update-record-from-slots employee1 '(first-name last-name email))
 336                (let ((lenin (car (clsql:select 'employee
 337                                                :where [= [slot-value 'employee 'emplid]
 338                                                          1]
 339                                                :flatp t
 340                                                :caching nil))))
 341                  (concatenate 'string
 342                               (first-name lenin)
 343                               " "
 344                               (last-name lenin)
 345                               ": "
 346                               (employee-email lenin))))
 347              (progn
 348                (setf (slot-value employee1 'first-name) "Vladimir"
 349                      (slot-value employee1 'last-name) "Lenin"
 350                      (slot-value employee1 'email) "lenin@soviet.org")
 351                (clsql:update-record-from-slots employee1 '(first-name last-name email))
 352                (let ((lenin (car (clsql:select 'employee
 353                                                :where [= [slot-value 'employee 'emplid]
 354                                                          1]
 355                                                :flatp t
 356                                                :caching nil))))
 357                  (concatenate 'string
 358                               (first-name lenin)
 359                               " "
 360                               (last-name lenin)
 361                               ": "
 362                               (employee-email lenin)))))
 363           "Vladimir Lenin: lenin@soviet.org"
 364           "Dimitriy Ivanovich: ivanovich@soviet.org"
 365           "Vladimir Lenin: lenin@soviet.org")
 366
 367         (deftest :oodml/update-records/4
 368           (flet ((print-fresh-node ()
 369                    (let ((base (car (clsql:select 'node
 370                                       :where [= [slot-value 'node 'node-id]
 371                                                 1]
 372                                       :flatp t
 373                                       :caching nil))))
 374                      (format nil "~a ~a"
 375                              (slot-value base 'node-id)
 376                              (slot-value base 'title)))))
 377             (values
 378               (print-fresh-node)
 379               (let ((base (car (clsql:select 'node
 380                                  :where [= [slot-value 'node 'node-id]
 381                                            1]
 382                                  :flatp t
 383                                  :caching nil))))
 384                 (setf (slot-value base 'title) "Altered title")
 385                 (clsql:update-records-from-instance base)
 386                 (print-fresh-node))
 387               (let ((base (car (clsql:select 'node
 388                                  :where [= [slot-value 'node 'node-id]
 389                                            1]
 390                                  :flatp t
 391                                  :caching nil))))
 392                 (setf (slot-value base 'title) "Bare node")
 393                 (clsql:update-records-from-instance base)
 394                 (print-fresh-node))))
 395           "1 Bare node"
 396           "1 Altered title"
 397           "1 Bare node")
 398
 399         (deftest :oodml/update-records/5
 400           (flet ((print-fresh-setting ()
 401                    (let ((node (car (clsql:select 'setting
 402                                       :where [= [slot-value 'setting 'setting-id]
 403                                                 3]
 404                                       :flatp t
 405                                       :caching nil))))
 406                      (format nil "~a ~a ~a"
 407                              (slot-value node 'setting-id)
 408                              (slot-value node 'title)
 409                              (slot-value node 'vars)))))
 410             (values
 411               (print-fresh-setting)
 412               (let ((node (car (clsql:select 'setting
 413                                  :where [= [slot-value 'setting 'setting-id]
 414                                            3]
 415                                  :flatp t
 416                                  :caching nil))))
 417                 (setf (slot-value node 'title) "Altered title")
 418                 (setf (slot-value node 'vars) "Altered vars")
 419                 (clsql:update-records-from-instance node)
 420                 (print-fresh-setting))
 421               (let ((node (car (clsql:select 'setting
 422                                  :where [= [slot-value 'setting 'setting-id]
 423                                            3]
 424                                  :flatp t
 425                                  :caching nil))))
 426                 (setf (slot-value node 'title) "Setting2")
 427                 (setf (slot-value node 'vars) "var 2")
 428                 (clsql:update-records-from-instance node)
 429                 (print-fresh-setting))))
 430           "3 Setting2 var 2"
 431           "3 Altered title Altered vars"
 432           "3 Setting2 var 2")
 433
 434         (deftest :oodml/update-records/6
 435           (flet ((print-fresh-setting ()
 436                    (let ((node (car (clsql:select 'setting
 437                                       :where [= [slot-value 'setting 'setting-id]
 438                                                 7]
 439                                       :flatp t
 440                                       :caching nil))))
 441                      (format nil "~a ~a ~a"
 442                              (slot-value node 'setting-id)
 443                              (slot-value node 'title)
 444                              (slot-value node 'vars)))
 445                    ))
 446             (values
 447               (print-fresh-setting)
 448               (let ((node (car (clsql:select 'setting
 449                                  :where [= [slot-value 'setting 'setting-id]
 450                                            7]
 451                                  :flatp t
 452                                  :caching nil))))
 453                 (setf (slot-value node 'title) "Altered title")
 454                 (setf (slot-value node 'vars) "Altered vars")
 455                 (clsql:update-records-from-instance node)
 456                 (print-fresh-setting))
 457               (let ((node (car (clsql:select 'setting
 458                                  :where [= [slot-value 'setting 'setting-id]
 459                                            7]
 460                                  :flatp t
 461                                  :caching nil))))
 462                 (setf (slot-value node 'title) "theme-2")
 463                 (setf (slot-value node 'vars) nil)
 464                 (clsql:update-records-from-instance node)
 465                 (print-fresh-setting))))
 466           "7 theme-2 NIL"
 467           "7 Altered title Altered vars"
 468           "7 theme-2 NIL")
 469
 470         (deftest :oodml/update-records/7
 471          (flet ((print-fresh-user ()
 472                   "requery to get what the db has, and print out."
 473                   (let ((node (car (clsql:select 'user
 474                                      :where [= [slot-value 'user 'user-id]
 475                                                5]
 476                                      :flatp t
 477                                      :caching nil))))
 478                     (format nil "~a ~a ~a"
 479                             (slot-value node 'user-id)
 480                             (slot-value node 'title)
 481                             (slot-value node 'nick)))))
 482            (values
 483              (print-fresh-user)
 484              (let ((node (car (clsql:select 'user
 485                                 :where [= [slot-value 'user 'user-id]
 486                                           5]
 487                                 :flatp t
 488                                 :caching nil))))
 489                (setf (slot-value node 'title) "Altered title")
 490                (setf (slot-value node 'nick) "Altered nick")
 491                (clsql:update-records-from-instance node)
 492                (print-fresh-user))
 493              (let ((node (car (clsql:select 'user
 494                                 :where [= [slot-value 'user 'user-id]
 495                                           5]
 496                                 :flatp t
 497                                 :caching nil))))
 498                (setf (slot-value node 'title) "user-2")
 499                (setf (slot-value node 'nick) "second user")
 500                (clsql:update-records-from-instance node)
 501                (print-fresh-user))))
 502           "5 user-2 second user"
 503           "5 Altered title Altered nick"
 504           "5 user-2 second user")
 505
 506         (deftest :oodml/update-records/8
 507           (flet ((print-fresh-theme ()
 508                    (let ((node (car (clsql:select 'theme
 509                                       :where [= [slot-value 'theme 'theme-id]
 510                                                 6]
 511                                       :flatp t
 512                                       :caching nil))))
 513                      (format nil "~a ~a ~a ~a ~a ~a"
 514                              (slot-value node 'node-id)
 515                              (slot-value node 'setting-id)
 516                              (slot-value node 'theme-id)
 517                              (slot-value node 'title)
 518                              (slot-value node 'vars)
 519                              (slot-value node 'doc)))))
 520             (values
 521               (print-fresh-theme)
 522               (let ((node (car (clsql:select 'setting
 523                                  :where [= [slot-value 'setting 'setting-id]
 524                                            6]
 525                                  :flatp t
 526                                  :caching nil))))
 527                 (setf (slot-value node 'title) "Altered title")
 528                 (setf (slot-value node 'vars) nil)
 529                 (clsql:update-records-from-instance node)
 530                 (print-fresh-theme))
 531               (let ((node (car (clsql:select 'theme
 532                                  :where [= [slot-value 'theme 'theme-id]
 533                                            6]
 534                                  :flatp t
 535                                  :caching nil))))
 536                 (setf (slot-value node 'title) "Altered title again")
 537                 (setf (slot-value node 'doc) "altered doc")
 538                 (clsql:update-records-from-instance node)
 539                 (print-fresh-theme))
 540               (let ((node (car (clsql:select 'theme
 541                                  :where [= [slot-value 'theme 'theme-id]
 542                                            6]
 543                                  :flatp t
 544                                  :caching nil))))
 545                 (setf (slot-value node 'title) "theme-1")
 546                 (setf (slot-value node 'vars) "empty")
 547                 (setf (slot-value node 'doc) "first theme")
 548                 (clsql:update-records-from-instance node)
 549                 (print-fresh-theme))))
 550           "6 6 6 theme-1 empty first theme"
 551           "6 6 6 Altered title NIL first theme"
 552           "6 6 6 Altered title again NIL altered doc"
 553           "6 6 6 theme-1 empty first theme")
 554
 555         (deftest :oodml/update-records/9
 556           (flet ((print-fresh-subloc ()
 557                    (let ((sl (car (clsql:select 'subloc
 558                                     :where [= [slot-value 'subloc 'subloc-id]
 559                                               10]
 560                                     :flatp t
 561                                     :caching nil))))
 562                      (format nil "~a ~a ~a"
 563                              (slot-value sl 'subloc-id)
 564                              (slot-value sl 'title)
 565                              (slot-value sl 'loc)))))
 566             (values
 567               (print-fresh-subloc)
 568               (let ((sl (car (clsql:select 'subloc
 569                                :where [= [slot-value 'subloc 'subloc-id]
 570                                          10]
 571                                :flatp t
 572                                :caching nil))))
 573                 (setf (slot-value sl 'title) "Altered subloc title")
 574                 (setf (slot-value sl 'loc) "Altered loc")
 575                 (clsql:update-records-from-instance sl)
 576                 (print-fresh-subloc))
 577               (let ((sl (car (clsql:select 'subloc
 578                                :where [= [slot-value 'subloc 'subloc-id]
 579                                          10]
 580                                :flatp t
 581                                :caching nil))))
 582                 (setf (slot-value sl 'title) "subloc-1")
 583                 (setf (slot-value sl 'loc) "a subloc")
 584                 (clsql:update-records-from-instance sl)
 585                 (print-fresh-subloc))))
 586           "10 subloc-1 a subloc"
 587           "10 Altered subloc title Altered loc"
 588           "10 subloc-1 a subloc")
 589
 590         ;; tests update-instance-from-records
 591         (deftest :oodml/update-instance/1
 592             (values
 593              (concatenate 'string
 594                           (slot-value employee1 'first-name)
 595                           " "
 596                           (slot-value employee1 'last-name)
 597                           ": "
 598                           (slot-value employee1 'email))
 599              (progn
 600                (clsql:update-records [employee]
 601                                      :av-pairs '(([first-name] "Ivan")
 602                                                  ([last-name] "Petrov")
 603                                                  ([email] "petrov@soviet.org"))
 604                                      :where [= [emplid] 1])
 605                (clsql:update-instance-from-records employee1)
 606                (concatenate 'string
 607                             (slot-value employee1 'first-name)
 608                             " "
 609                             (slot-value employee1 'last-name)
 610                             ": "
 611                             (slot-value employee1 'email)))
 612              (progn
 613                (clsql:update-records [employee]
 614                                      :av-pairs '(([first-name] "Vladimir")
 615                                                  ([last-name] "Lenin")
 616                                                  ([email] "lenin@soviet.org"))
 617                                      :where [= [emplid] 1])
 618                (clsql:update-instance-from-records employee1)
 619                (concatenate 'string
 620                             (slot-value employee1 'first-name)
 621                             " "
 622                             (slot-value employee1 'last-name)
 623                             ": "
 624                             (slot-value employee1 'email))))
 625           "Vladimir Lenin: lenin@soviet.org"
 626           "Ivan Petrov: petrov@soviet.org"
 627           "Vladimir Lenin: lenin@soviet.org")
 628
 629         ;; tests update-slot-from-record
 630         (deftest :oodml/update-instance/2
 631             (values
 632              (slot-value employee1 'email)
 633              (progn
 634                (clsql:update-records [employee]
 635                                      :av-pairs '(([email] "lenin-nospam@soviet.org"))
 636                                      :where [= [emplid] 1])
 637                (clsql:update-slot-from-record employee1 'email)
 638                (slot-value employee1 'email))
 639              (progn
 640                (clsql:update-records [employee]
 641                                      :av-pairs '(([email] "lenin@soviet.org"))
 642                                      :where [= [emplid] 1])
 643                (clsql:update-slot-from-record employee1 'email)
 644                (slot-value employee1 'email)))
 645           "lenin@soviet.org" "lenin-nospam@soviet.org" "lenin@soviet.org")
 646
 647         ;; tests normalisedp update-instance-from-records
 648         (deftest :oodml/update-instance/3
 649             (values
 650              (with-output-to-string (out)
 651                (format out "~a ~a ~a ~a"
 652                        (slot-value theme2 'theme-id)
 653                        (slot-value theme2 'title)
 654                        (slot-value theme2 'vars)
 655                        (slot-value theme2 'doc)))
 656              (progn
 657                (clsql:update-records [node] :av-pairs '(([title] "Altered title"))
 658                                      :where [= [node-id] 7])
 659                (clsql:update-records [setting] :av-pairs '(([vars] "Altered vars"))
 660                                      :where [= [setting-id] 7])
 661                (clsql:update-records [theme] :av-pairs '(([doc] "Altered doc"))
 662                                      :where [= [theme-id] 7])
 663                (clsql:update-instance-from-records theme2)
 664                (with-output-to-string (out)
 665                  (format out "~a ~a ~a ~a"
 666                          (slot-value theme2 'theme-id)
 667                          (slot-value theme2 'title)
 668                          (slot-value theme2 'vars)
 669                          (slot-value theme2 'doc))))
 670              (progn
 671                (clsql:update-records [node] :av-pairs '(([title] "theme-2"))
 672                                      :where [= [node-id] 7])
 673                (clsql:update-records [setting] :av-pairs '(([vars] nil))
 674                                      :where [= [setting-id] 7])
 675                (clsql:update-records [theme] :av-pairs '(([doc] "second theme"))
 676                                      :where [= [theme-id] 7])
 677                (clsql:update-instance-from-records theme2)
 678                (with-output-to-string (out)
 679                  (format out "~a ~a ~a ~a"
 680                          (slot-value theme2 'theme-id)
 681                          (slot-value theme2 'title)
 682                          (slot-value theme2 'vars)
 683                          (slot-value theme2 'doc)))))
 684           "7 theme-2 NIL second theme"
 685           "7 Altered title Altered vars Altered doc"
 686           "7 theme-2 NIL second theme")
 687
 688         (deftest :oodml/update-instance/4
 689                    (values
 690                         (progn
 691                           (setf loc2 (car (clsql:select 'location
 692                                                                                         :where [= [node-id] 9]
 693                                                                                         :flatp t :caching nil)))
 694                           (with-output-to-string (out)
 695                                 (format out "~a ~a"
 696                                                 (slot-value loc2 'node-id)
 697                                                 (slot-value loc2 'title))))
 698                         (progn
 699                           (clsql:update-records [node] :av-pairs '(([title] "Altered title"))
 700                                                                         :where [= [node-id] 9])
 701                           (clsql:update-instance-from-records loc2)
 702                           (with-output-to-string (out)
 703                                 (format out "~a ~a"
 704                                                 (slot-value loc2 'node-id)
 705                                                 (slot-value loc2 'title))))
 706                         (progn
 707                           (clsql:update-records [node] :av-pairs '(([title] "location-2"))
 708                                                                         :where [= [node-id] 9])
 709                           (clsql:update-instance-from-records loc2)
 710                           (with-output-to-string (out)
 711                                 (format out "~a ~a"
 712                                                 (slot-value loc2 'node-id)
 713                                                 (slot-value loc2 'title)))))
 714           "9 location-2"
 715           "9 Altered title"
 716           "9 location-2")
 717
 718         (deftest :oodml/update-instance/5
 719             (values
 720              (with-output-to-string (out)
 721                (format out "~a ~a ~a"
 722                        (slot-value subloc2 'subloc-id)
 723                        (slot-value subloc2 'title)
 724                        (slot-value subloc2 'loc)))
 725              (progn
 726                (clsql:update-records [node] :av-pairs '(([title] "Altered title"))
 727                                      :where [= [node-id] 11])
 728                (clsql:update-records [subloc] :av-pairs '(([loc] "Altered loc"))
 729                                      :where [= [subloc-id] 11])
 730                (clsql:update-instance-from-records subloc2)
 731                (with-output-to-string (out)
 732                  (format out "~a ~a ~a"
 733                          (slot-value subloc2 'subloc-id)
 734                          (slot-value subloc2 'title)
 735                          (slot-value subloc2 'loc))))
 736              (progn
 737                (clsql:update-records [node] :av-pairs '(([title] "subloc-2"))
 738                                      :where [= [node-id] 11])
 739                (clsql:update-records [subloc] :av-pairs '(([loc] "second subloc"))
 740                                      :where [= [subloc-id] 11])
 741                (clsql:update-instance-from-records subloc2)
 742                (with-output-to-string (out)
 743                  (format out "~a ~a ~a"
 744                          (slot-value subloc2 'subloc-id)
 745                          (slot-value subloc2 'title)
 746                          (slot-value subloc2 'loc)))))
 747           "11 subloc-2 second subloc"
 748           "11 Altered title Altered loc"
 749           "11 subloc-2 second subloc")
 750
 751         ;; tests update-slot-from-record with normalisedp stuff
 752         (deftest :oodml/update-instance/6
 753             (values
 754              (slot-value theme1 'doc)
 755              (slot-value theme1 'vars)
 756              (progn
 757                (clsql:update-records [theme]
 758                                      :av-pairs '(([doc] "altered doc"))
 759                                      :where [= [theme-id] 6])
 760                (clsql:update-slot-from-record theme1 'doc)
 761                (slot-value theme1 'doc))
 762              (progn
 763                (clsql:update-records [setting]
 764                                      :av-pairs '(([vars] "altered vars"))
 765                                      :where [= [setting-id] 6])
 766                (clsql:update-slot-from-record theme1 'vars)
 767                (slot-value theme1 'vars))
 768              (progn
 769                (clsql:update-records [theme]
 770                                      :av-pairs '(([doc] "first theme"))
 771                                      :where [= [theme-id] 6])
 772                (clsql:update-slot-from-record theme1 'doc)
 773                (slot-value theme1 'doc))
 774              (progn
 775                (clsql:update-records [setting]
 776                                      :av-pairs '(([vars] "empty"))
 777                                      :where [= [setting-id] 6])
 778                (clsql:update-slot-from-record theme1 'vars)
 779                (slot-value theme1 'vars)))
 780          "first theme" "empty"
 781          "altered doc" "altered vars"
 782          "first theme" "empty")
 783
 784         (deftest :oodml/update-instance/7
 785             (values
 786              (slot-value loc2 'title)
 787              (slot-value subloc2 'loc)
 788              (progn
 789                (clsql:update-records [node]
 790                                      :av-pairs '(([title] "altered title"))
 791                                      :where [= [node-id] 9])
 792                (clsql:update-slot-from-record loc2 'title)
 793                (slot-value loc2 'title))
 794              (progn
 795                (clsql:update-records [subloc]
 796                                      :av-pairs '(([loc] "altered loc"))
 797                                      :where [= [subloc-id] 11])
 798                (clsql:update-slot-from-record subloc2 'loc)
 799                (slot-value subloc2 'loc))
 800              (progn
 801                (clsql:update-records [node]
 802                                      :av-pairs '(([title] "location-2"))
 803                                      :where [= [node-id] 9])
 804                (clsql:update-slot-from-record loc2 'title)
 805                (slot-value loc2 'title))
 806              (progn
 807                (clsql:update-records [subloc]
 808                                      :av-pairs '(([loc] "second subloc"))
 809                                      :where [= [subloc-id] 11])
 810                (clsql:update-slot-from-record subloc2 'loc)
 811                (slot-value subloc2 'loc)))
 812          "location-2" "second subloc"
 813                  "altered title" "altered loc"
 814          "location-2" "second subloc")
 815
 816         (deftest :oodml/do-query/1
 817             (let ((result '()))
 818               (clsql:do-query ((e) [select 'employee :order-by [emplid]])
 819                 (push (slot-value e 'last-name) result))
 820               result)
 821           ("Putin" "Yeltsin" "Gorbachev" "Chernenko" "Andropov" "Brezhnev" "Kruschev"
 822            "Trotsky" "Stalin" "Lenin"))
 823
 824         (deftest :oodml/do-query/2
 825             (let ((result '()))
 826               (clsql:do-query ((e c) [select 'employee 'company
 827                                              :where [= [slot-value 'employee 'last-name]
 828                                                        "Lenin"]])
 829                 (push (list (slot-value e 'last-name) (slot-value c 'name))
 830                       result))
 831               result)
 832           (("Lenin" "Widgets Inc.")))
 833
 834         (deftest :oodml/map-query/1
 835             (clsql:map-query 'list #'last-name [select 'employee :order-by [emplid]])
 836           ("Lenin" "Stalin" "Trotsky" "Kruschev" "Brezhnev" "Andropov" "Chernenko"
 837            "Gorbachev" "Yeltsin" "Putin"))
 838
 839         (deftest :oodml/map-query/2
 840             (clsql:map-query 'list #'(lambda (e c) (list (slot-value e 'last-name)
 841                                                          (slot-value c 'name)))
 842              [select 'employee 'company :where [= [slot-value 'employee 'last-name]
 843                                                   "Lenin"]])
 844           (("Lenin" "Widgets Inc.")))
 845
 846         (deftest :oodml/iteration/3
 847             (loop for (e) being the records in
 848              [select 'employee :where [< [emplid] 4] :order-by [emplid]]
 849              collect (slot-value e 'last-name))
 850           ("Lenin" "Stalin" "Trotsky"))
 851
 852
 853       (deftest :oodml/cache/1
 854           (progn
 855             (setf (clsql-sys:record-caches *default-database*) nil)
 856             (let ((employees (select 'employee)))
 857               (every #'(lambda (a b) (eq a b))
 858                      employees (select 'employee))))
 859         t)
 860
 861         (deftest :oodml/cache/2
 862             (let ((employees (select 'employee)))
 863               (equal employees (select 'employee :flatp t)))
 864           nil)
 865
 866         (deftest :oodml/refresh/1
 867             (let ((addresses (select 'address)))
 868               (equal addresses (select 'address :refresh t)))
 869           t)
 870
 871         (deftest :oodml/refresh/2
 872             (let* ((addresses (select 'address :order-by [addressid] :flatp t :refresh t))
 873                    (city (slot-value (car addresses) 'city)))
 874               (clsql:update-records [addr]
 875                               :av-pairs '((city_field "A new city"))
 876                               :where [= [addressid] (slot-value (car addresses) 'addressid)])
 877               (let* ((new-addresses (select 'address :order-by [addressid] :refresh t :flatp t))
 878                      (new-city (slot-value (car addresses) 'city))
 879 )
 880                 (clsql:update-records [addr]
 881                                       :av-pairs `((city_field ,city))
 882                                       :where [= [addressid] (slot-value (car addresses) 'addressid)])
 883                 (values (equal addresses new-addresses)
 884                         city
 885                         new-city)))
 886           t "Leningrad" "A new city")
 887
 888         (deftest :oodml/refresh/3
 889             (let* ((addresses (select 'address :order-by [addressid] :flatp t)))
 890               (values
 891                (equal addresses (select 'address :refresh t :flatp t))
 892                (equal addresses (select 'address :flatp t))))
 893           nil nil)
 894
 895         (deftest :oodml/refresh/4
 896             (let* ((addresses (select 'address :order-by [addressid] :flatp t :refresh t))
 897                    (*db-auto-sync* t))
 898               (make-instance 'address :addressid 1000 :city "A new address city")
 899               (let ((new-addresses (select 'address :order-by [addressid] :flatp t :refresh t)))
 900                 (delete-records :from [addr] :where [= [addressid] 1000])
 901                 (values
 902                  (length addresses)
 903                  (length new-addresses)
 904                  (eq (first addresses) (first new-addresses))
 905                  (eq (second addresses) (second new-addresses)))))
 906           2 3 t t)
 907
 908
 909         (deftest :oodml/uoj/1
 910             (progn
 911               (let* ((dea-list (select 'deferred-employee-address :caching nil :order-by ["ea_join" aaddressid]
 912                                        :flatp t))
 913                      (dea-list-copy (copy-seq dea-list))
 914                      (initially-unbound (every #'(lambda (dea) (not (slot-boundp dea 'address))) dea-list)))
 915                 (update-objects-joins dea-list)
 916                 (values
 917                  initially-unbound
 918                  (equal dea-list dea-list-copy)
 919                  (every #'(lambda (dea) (slot-boundp dea 'address)) dea-list)
 920                  (every #'(lambda (dea) (typep (slot-value dea 'address) 'address)) dea-list)
 921                  (mapcar #'(lambda (dea) (slot-value (slot-value dea 'address) 'addressid)) dea-list))))
 922           t t t t (1 1 2 2 2))
 923
 924         ;; update-object-joins needs to be fixed for multiple keys
 925         #+ignore
 926         (deftest :oodml/uoj/2
 927             (progn
 928               (clsql:update-objects-joins (list company1))
 929               (mapcar #'(lambda (e)
 930                           (slot-value e 'ecompanyid))
 931                  (company-employees company1)))
 932           (1 1 1 1 1 1 1 1 1 1))
 933
 934         (deftest :oodml/big/1
 935             (let ((objs (clsql:select 'big :order-by [i] :flatp t)))
 936               (values
 937                (length objs)
 938                (do ((i 0 (1+ i))
 939                     (max (expt 2 60))
 940                     (rest objs (cdr rest)))
 941                    ((= i (length objs)) t)
 942                  (let ((obj (car rest))
 943                        (index (1+ i)))
 944                    (unless (and (eql (slot-value obj 'i) index)
 945                                 (eql (slot-value obj 'bi) (truncate max index)))
 946                      (print index)
 947                      (describe obj)
 948                      (return nil))))))
 949           555 t)
 950
 951         (deftest :oodml/db-auto-sync/1
 952             (values
 953               (progn
 954                 (make-instance 'employee :emplid 20 :groupid 1
 955                                :last-name "Ivanovich")
 956                 (select [last-name] :from [employee] :where [= [emplid] 20]
 957                         :flatp t :field-names nil))
 958              (let ((*db-auto-sync* t))
 959                (make-instance 'employee :emplid 20 :groupid 1
 960                               :last-name "Ivanovich")
 961                (prog1 (select [last-name] :from [employee] :flatp t
 962                               :field-names nil
 963                               :where [= [emplid] 20])
 964                  (delete-records :from [employee] :where [= [emplid] 20]))))
 965           nil ("Ivanovich"))
 966
 967         (deftest :oodml/db-auto-sync/2
 968             (values
 969              (let ((instance (make-instance 'employee :emplid 20 :groupid 1
 970                                             :last-name "Ivanovich")))
 971                (setf (slot-value instance 'last-name) "Bulgakov")
 972                (select [last-name] :from [employee] :where [= [emplid] 20]
 973                        :flatp t :field-names nil))
 974              (let* ((*db-auto-sync* t)
 975                     (instance (make-instance 'employee :emplid 20 :groupid 1
 976                                              :last-name "Ivanovich")))
 977                (setf (slot-value instance 'last-name) "Bulgakov")
 978                (prog1 (select [last-name] :from [employee] :flatp t
 979                               :field-names nil
 980                               :where [= [emplid] 20])
 981                  (delete-records :from [employee] :where [= [emplid] 20]))))
 982           nil ("Bulgakov"))
 983
 984         (deftest :oodml/db-auto-sync/3
 985             (values
 986               (progn
 987                 (make-instance 'theme :title "test-theme" :vars "test-vars"
 988                                :doc "test-doc")
 989                 (select [node-id] :from [node] :where [= [title] "test-theme"]
 990                         :flatp t :field-names nil))
 991              (let ((*db-auto-sync* t))
 992                 (make-instance 'theme :title "test-theme" :vars "test-vars"
 993                                :doc "test-doc")
 994                 (prog1 (select [title] :from [node] :where [= [title] "test-theme"]
 995                         :flatp t :field-names nil)
 996                   (delete-records :from [node] :where [= [title] "test-theme"])
 997                   (delete-records :from [setting] :where [= [vars] "test-vars"])
 998                   (delete-records :from [theme] :where [= [doc] "test-doc"]))))
 999           nil ("test-theme"))
1000
1001         (deftest :oodml/db-auto-sync/4
1002             (values
1003               (let ((inst (make-instance 'theme
1004                                          :title "test-theme" :vars "test-vars"
1005                                          :doc "test-doc")))
1006                 (setf (slot-value inst 'title) "alternate-test-theme")
1007                 (with-output-to-string (out)
1008                   (format out "~a ~a ~a ~a"
1009                           (select [title] :from [node]
1010                                   :where [= [title] "test-theme"]
1011                                   :flatp t :field-names nil)
1012                           (select [vars] :from [setting]
1013                                   :where [= [vars] "test-vars"]
1014                                   :flatp t :field-names nil)
1015                           (select [doc] :from [theme]
1016                                   :where [= [doc] "test-doc"]
1017                                   :flatp t :field-names nil)
1018                           (select [title] :from [node]
1019                                   :where [= [title] "alternate-test-theme"]
1020                                   :flatp t :field-names nil))))
1021              (let* ((*db-auto-sync* t)
1022                     (inst (make-instance 'theme
1023                                          :title "test-theme" :vars "test-vars"
1024                                          :doc "test-doc")))
1025                 (setf (slot-value inst 'title) "alternate-test-theme")
1026                 (prog1
1027                 (with-output-to-string (out)
1028                   (format out "~a ~a ~a ~a"
1029                           (select [title] :from [node]
1030                                   :where [= [title] "test-theme"]
1031                                   :flatp t :field-names nil)
1032                           (select [vars] :from [setting]
1033                                   :where [= [vars] "test-vars"]
1034                                   :flatp t :field-names nil)
1035                           (select [doc] :from [theme]
1036                                   :where [= [doc] "test-doc"]
1037                                   :flatp t :field-names nil)
1038                           (select [title] :from [node]
1039                                   :where [= [title] "alternate-test-theme"]
1040                                   :flatp t :field-names nil)))
1041                   (delete-records :from [node] :where [= [title] "alternate-test-theme"])
1042                   (delete-records :from [setting] :where [= [vars] "test-vars"])
1043                   (delete-records :from [theme] :where [= [doc] "test-doc"]))))
1044          "NIL NIL NIL NIL"
1045          "NIL (test-vars) (test-doc) (alternate-test-theme)")
1046
1047         (deftest :oodml/setf-slot-value/1
1048             (let* ((*db-auto-sync* t)
1049                    (instance (make-instance 'employee :emplid 20 :groupid 1)))
1050               (prog1
1051                   (setf
1052                    (slot-value instance 'first-name) "Mikhail"
1053                    (slot-value instance 'last-name) "Bulgakov")
1054                 (delete-records :from [employee] :where [= [emplid] 20])))
1055           "Bulgakov")
1056
1057         (deftest :oodml/float/1
1058             (let* ((emp1 (car (select 'employee
1059                                       :where [= [slot-value 'employee 'emplid]
1060                                                 1]
1061                                       :flatp t
1062                                       :caching nil)))
1063                    (height (slot-value emp1 'height)))
1064               (prog1
1065                   (progn
1066                     (setf (slot-value emp1 'height) 1.0E0)
1067                     (clsql:update-record-from-slot emp1 'height)
1068                     (= (car (clsql:select [height] :from [employee]
1069                                           :where [= [emplid] 1]
1070                                           :flatp t
1071                                           :field-names nil))
1072                        1))
1073                 (setf (slot-value emp1 'height) height)
1074                 (clsql:update-record-from-slot emp1 'height)))
1075          t)
1076
1077         (deftest :oodml/float/2
1078             (let* ((emp1 (car (select 'employee
1079                                      :where [= [slot-value 'employee 'emplid]
1080                                                1]
1081                                      :flatp t
1082                                      :caching nil)))
1083                    (height (slot-value emp1 'height)))
1084               (prog1
1085                   (progn
1086                     (setf (slot-value emp1 'height) 1.0S0)
1087                     (clsql:update-record-from-slot emp1 'height)
1088                     (= (car (clsql:select [height] :from [employee]
1089                                           :where [= [emplid] 1]
1090                                           :flatp t
1091                                           :field-names nil))
1092                        1))
1093                 (setf (slot-value emp1 'height) height)
1094                 (clsql:update-record-from-slot emp1 'height)))
1095          t)
1096
1097         (deftest :oodml/float/3
1098             (let* ((emp1 (car (select 'employee
1099                                      :where [= [slot-value 'employee 'emplid]
1100                                                1]
1101                                      :flatp t
1102                                      :caching nil)))
1103                    (height (slot-value emp1 'height)))
1104               (prog1
1105                   (progn
1106                     (setf (slot-value emp1 'height) 1.0F0)
1107                     (clsql:update-record-from-slot emp1 'height)
1108                     (= (car (clsql:select [height] :from [employee]
1109                                           :where [= [emplid] 1]
1110                                           :flatp t
1111                                           :field-names nil))
1112                        1))
1113                 (setf (slot-value emp1 'height) height)
1114                 (clsql:update-record-from-slot emp1 'height)))
1115           t)
1116
1117         (deftest :oodml/float/4
1118             (let* ((emp1 (car (select 'employee
1119                                      :where [= [slot-value 'employee 'emplid]
1120                                                1]
1121                                      :flatp t
1122                                      :caching nil)))
1123                    (height (slot-value emp1 'height)))
1124               (prog1
1125                   (progn
1126                     (setf (slot-value emp1 'height) 1.0D0)
1127                     (clsql:update-record-from-slot emp1 'height)
1128                     (= (car (clsql:select [height] :from [employee]
1129                                           :where [= [emplid] 1]
1130                                           :flatp t
1131                                           :field-names nil))
1132                        1))
1133                 (setf (slot-value emp1 'height) height)
1134                 (clsql:update-record-from-slot emp1 'height)))
1135          t)
1136
1137         (deftest :oodml/float/5
1138             (let* ((emp1 (car (select 'employee
1139                                       :where [= [slot-value 'employee 'emplid]
1140                                                 1]
1141                                       :flatp t
1142                                       :caching nil)))
1143                    (height (slot-value emp1 'height)))
1144               (prog1
1145                   (progn
1146                     (setf (slot-value emp1 'height) 1.0L0)
1147                     (clsql:update-record-from-slot emp1 'height)
1148                     (= (car (clsql:select [height] :from [employee]
1149                                           :where [= [emplid] 1]
1150                                           :flatp t
1151                                           :field-names nil))
1152                        1))
1153                 (setf (slot-value emp1 'height) height)
1154                 (clsql:update-record-from-slot emp1 'height)))
1155          t)))
1156
1157
1158
1159 #.(clsql:restore-sql-reader-syntax-state)