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 [= 1 [slot-value 'node 'node-id]]
 371                                       :flatp t :caching nil))))
 372                      (format nil "~a ~a"
 373                              (slot-value base 'node-id)
 374                              (slot-value base 'title)))))
 375             (values
 376               (print-fresh-node)
 377               (let ((base (car (clsql:select 'node
 378                                  :where [= 1 [slot-value 'node 'node-id]]
 379                                  :flatp t :caching nil))))
 380                 (setf (slot-value base 'title) "Altered title")
 381                 (clsql:update-records-from-instance base)
 382                 (print-fresh-node))
 383               (let ((base (car (clsql:select 'node
 384                                  :where [= 1 [slot-value 'node 'node-id]]
 385                                  :flatp t :caching nil))))
 386                 (setf (slot-value base 'title) "Bare node")
 387                 (clsql:update-records-from-instance base)
 388                 (print-fresh-node))))
 389           "1 Bare node"
 390           "1 Altered title"
 391           "1 Bare node")
 392
 393         (deftest :oodml/update-records/5
 394           (flet ((print-fresh-setting ()
 395                    (let ((node (car (clsql:select 'setting
 396                                       :where [= 3 [slot-value 'setting 'setting-id]]
 397                                       :flatp t :caching nil))))
 398                      (format nil "~a ~a ~a"
 399                              (slot-value node 'setting-id)
 400                              (slot-value node 'title)
 401                              (slot-value node 'vars)))))
 402             (values
 403               (print-fresh-setting)
 404               (let ((node (car (clsql:select 'setting
 405                                  :where [= 3 [slot-value 'setting 'setting-id]]
 406                                  :flatp t :caching nil))))
 407                 (setf (slot-value node 'title) "Altered title")
 408                 (setf (slot-value node 'vars) "Altered vars")
 409                 (clsql:update-records-from-instance node)
 410                 (print-fresh-setting))
 411               (let ((node (car (clsql:select 'setting
 412                                  :where [= 3 [slot-value 'setting 'setting-id]]
 413                                  :flatp t :caching nil))))
 414                 (setf (slot-value node 'title) "Setting2")
 415                 (setf (slot-value node 'vars) "var 2")
 416                 (clsql:update-records-from-instance node)
 417                 (print-fresh-setting))))
 418           "3 Setting2 var 2"
 419           "3 Altered title Altered vars"
 420           "3 Setting2 var 2")
 421
 422         (deftest :oodml/update-records/6
 423           (flet ((print-fresh-setting ()
 424                    (let ((node (car (clsql:select 'setting
 425                                       :where [= 7 [slot-value 'setting 'setting-id]]
 426                                       :flatp t :caching nil))))
 427                      (format nil "~a ~a ~a"
 428                              (slot-value node 'setting-id)
 429                              (slot-value node 'title)
 430                              (slot-value node 'vars)))))
 431             (values
 432               (print-fresh-setting)
 433               (let ((node (car (clsql:select 'setting
 434                                  :where [= 7 [slot-value 'setting 'setting-id]]
 435                                  :flatp t :caching nil))))
 436                 (setf (slot-value node 'title) "Altered title")
 437                 (setf (slot-value node 'vars) "Altered vars")
 438                 (clsql:update-records-from-instance node)
 439                 (print-fresh-setting))
 440               (let ((node (car (clsql:select 'setting
 441                                  :where [= 7 [slot-value 'setting 'setting-id]]
 442                                  :flatp t :caching nil))))
 443                 (setf (slot-value node 'title) "theme-2")
 444                 (setf (slot-value node 'vars) nil)
 445                 (clsql:update-records-from-instance node)
 446                 (print-fresh-setting))))
 447           "7 theme-2 NIL"
 448           "7 Altered title Altered vars"
 449           "7 theme-2 NIL")
 450
 451         (deftest :oodml/update-records/7
 452          (flet ((print-fresh-user ()
 453                   "requery to get what the db has, and print out."
 454                   (let ((node (car (clsql:select 'user
 455                                      :where [= 5 [slot-value 'user 'user-id]]
 456                                      :flatp t :caching nil))))
 457                     (format nil "~a ~a ~a"
 458                             (slot-value node 'user-id)
 459                             (slot-value node 'title)
 460                             (slot-value node 'nick)))))
 461            (values
 462              (print-fresh-user)
 463              (let ((node (car (clsql:select 'user
 464                                 :where [= 5 [slot-value 'user 'user-id]]
 465                                 :flatp t :caching nil))))
 466                (setf (slot-value node 'title) "Altered title")
 467                (setf (slot-value node 'nick) "Altered nick")
 468                (clsql:update-records-from-instance node)
 469                (print-fresh-user))
 470              (let ((node (car (clsql:select 'user
 471                                 :where [= 5 [slot-value 'user 'user-id]]
 472                                 :flatp t :caching nil))))
 473                (setf (slot-value node 'title) "user-2")
 474                (setf (slot-value node 'nick) "second user")
 475                (clsql:update-records-from-instance node)
 476                (print-fresh-user))))
 477           "5 user-2 second user"
 478           "5 Altered title Altered nick"
 479           "5 user-2 second user")
 480
 481         (deftest :oodml/update-records/8
 482           (flet ((print-fresh-theme ()
 483                    (let ((node (car (clsql:select 'theme
 484                                       :where [= 6 [slot-value 'theme 'theme-id]]
 485                                       :flatp t :caching nil))))
 486                      (format nil "~a ~a ~a ~a ~a ~a"
 487                              (slot-value node 'node-id)
 488                              (slot-value node 'setting-id)
 489                              (slot-value node 'theme-id)
 490                              (slot-value node 'title)
 491                              (slot-value node 'vars)
 492                              (slot-value node 'doc)))))
 493             (values
 494               (print-fresh-theme)
 495               (let ((node (car (clsql:select 'setting
 496                                  :where [= 6 [slot-value 'setting 'setting-id]]
 497                                  :flatp t :caching nil))))
 498                 (setf (slot-value node 'title) "Altered title")
 499                 (setf (slot-value node 'vars) nil)
 500                 (clsql:update-records-from-instance node)
 501                 (print-fresh-theme))
 502               (let ((node (car (clsql:select 'theme
 503                                  :where [= 6 [slot-value 'theme 'theme-id]]
 504                                  :flatp t :caching nil))))
 505                 (setf (slot-value node 'title) "Altered title again")
 506                 (setf (slot-value node 'doc) "altered doc")
 507                 (clsql:update-records-from-instance node)
 508                 (print-fresh-theme))
 509               (let ((node (car (clsql:select 'theme
 510                                  :where [= 6 [slot-value 'theme 'theme-id]]
 511                                  :flatp t :caching nil))))
 512                 (setf (slot-value node 'title) "theme-1")
 513                 (setf (slot-value node 'vars) "empty")
 514                 (setf (slot-value node 'doc) "first theme")
 515                 (clsql:update-records-from-instance node)
 516                 (print-fresh-theme))))
 517           "6 6 6 theme-1 empty first theme"
 518           "6 6 6 Altered title NIL first theme"
 519           "6 6 6 Altered title again NIL altered doc"
 520           "6 6 6 theme-1 empty first theme")
 521
 522         (deftest :oodml/update-records/9
 523           (flet ((print-fresh-subloc ()
 524                    (let ((sl (car (clsql:select 'subloc
 525                                     :where [= 10 [slot-value 'subloc 'subloc-id]]
 526                                     :flatp t :caching nil))))
 527                      (format nil "~a ~a ~a"
 528                              (slot-value sl 'subloc-id)
 529                              (slot-value sl 'title)
 530                              (slot-value sl 'loc)))))
 531             (values
 532               (print-fresh-subloc)
 533               (let ((sl (car (clsql:select 'subloc
 534                                :where [= 10 [slot-value 'subloc 'subloc-id]]
 535                                :flatp t :caching nil))))
 536                 (setf (slot-value sl 'title) "Altered subloc title")
 537                 (setf (slot-value sl 'loc) "Altered loc")
 538                 (clsql:update-records-from-instance sl)
 539                 (print-fresh-subloc))
 540               (let ((sl (car (clsql:select 'subloc
 541                                :where [= 10 [slot-value 'subloc 'subloc-id]]
 542                                :flatp t :caching nil))))
 543                 (setf (slot-value sl 'title) "subloc-1")
 544                 (setf (slot-value sl 'loc) "a subloc")
 545                 (clsql:update-records-from-instance sl)
 546                 (print-fresh-subloc))))
 547           "10 subloc-1 a subloc"
 548           "10 Altered subloc title Altered loc"
 549           "10 subloc-1 a subloc")
 550
 551         ;; tests update-instance-from-records
 552         (deftest :oodml/update-instance/1
 553             (values
 554              (concatenate 'string
 555                           (slot-value employee1 'first-name)
 556                           " "
 557                           (slot-value employee1 'last-name)
 558                           ": "
 559                           (slot-value employee1 'email))
 560              (progn
 561                (clsql:update-records [employee]
 562                                      :av-pairs '(([first-name] "Ivan")
 563                                                  ([last-name] "Petrov")
 564                                                  ([email] "petrov@soviet.org"))
 565                                      :where [= [emplid] 1])
 566                (clsql:update-instance-from-records employee1)
 567                (concatenate 'string
 568                             (slot-value employee1 'first-name)
 569                             " "
 570                             (slot-value employee1 'last-name)
 571                             ": "
 572                             (slot-value employee1 'email)))
 573              (progn
 574                (clsql:update-records [employee]
 575                                      :av-pairs '(([first-name] "Vladimir")
 576                                                  ([last-name] "Lenin")
 577                                                  ([email] "lenin@soviet.org"))
 578                                      :where [= [emplid] 1])
 579                (clsql:update-instance-from-records employee1)
 580                (concatenate 'string
 581                             (slot-value employee1 'first-name)
 582                             " "
 583                             (slot-value employee1 'last-name)
 584                             ": "
 585                             (slot-value employee1 'email))))
 586           "Vladimir Lenin: lenin@soviet.org"
 587           "Ivan Petrov: petrov@soviet.org"
 588           "Vladimir Lenin: lenin@soviet.org")
 589
 590         ;; tests update-slot-from-record
 591         (deftest :oodml/update-instance/2
 592             (values
 593              (slot-value employee1 'email)
 594              (progn
 595                (clsql:update-records [employee]
 596                                      :av-pairs '(([email] "lenin-nospam@soviet.org"))
 597                                      :where [= [emplid] 1])
 598                (clsql:update-slot-from-record employee1 'email)
 599                (slot-value employee1 'email))
 600              (progn
 601                (clsql:update-records [employee]
 602                                      :av-pairs '(([email] "lenin@soviet.org"))
 603                                      :where [= [emplid] 1])
 604                (clsql:update-slot-from-record employee1 'email)
 605                (slot-value employee1 'email)))
 606           "lenin@soviet.org" "lenin-nospam@soviet.org" "lenin@soviet.org")
 607
 608         ;; tests normalisedp update-instance-from-records
 609         (deftest :oodml/update-instance/3
 610             (values
 611              (with-output-to-string (out)
 612                (format out "~a ~a ~a ~a"
 613                        (slot-value theme2 'theme-id)
 614                        (slot-value theme2 'title)
 615                        (slot-value theme2 'vars)
 616                        (slot-value theme2 'doc)))
 617              (progn
 618                (clsql:update-records [node] :av-pairs '(([title] "Altered title"))
 619                                      :where [= [node-id] 7])
 620                (clsql:update-records [setting] :av-pairs '(([vars] "Altered vars"))
 621                                      :where [= [setting-id] 7])
 622                (clsql:update-records [theme] :av-pairs '(([doc] "Altered doc"))
 623                                      :where [= [theme-id] 7])
 624                (clsql:update-instance-from-records theme2)
 625                (with-output-to-string (out)
 626                  (format out "~a ~a ~a ~a"
 627                          (slot-value theme2 'theme-id)
 628                          (slot-value theme2 'title)
 629                          (slot-value theme2 'vars)
 630                          (slot-value theme2 'doc))))
 631              (progn
 632                (clsql:update-records [node] :av-pairs '(([title] "theme-2"))
 633                                      :where [= [node-id] 7])
 634                (clsql:update-records [setting] :av-pairs '(([vars] nil))
 635                                      :where [= [setting-id] 7])
 636                (clsql:update-records [theme] :av-pairs '(([doc] "second theme"))
 637                                      :where [= [theme-id] 7])
 638                (clsql:update-instance-from-records theme2)
 639                (with-output-to-string (out)
 640                  (format out "~a ~a ~a ~a"
 641                          (slot-value theme2 'theme-id)
 642                          (slot-value theme2 'title)
 643                          (slot-value theme2 'vars)
 644                          (slot-value theme2 'doc)))))
 645           "7 theme-2 NIL second theme"
 646           "7 Altered title Altered vars Altered doc"
 647           "7 theme-2 NIL second theme")
 648
 649         (deftest :oodml/update-instance/4
 650                    (values
 651                         (progn
 652                           (setf loc2 (car (clsql:select 'location
 653                                                                                         :where [= [node-id] 9]
 654                                                                                         :flatp t :caching nil)))
 655                           (with-output-to-string (out)
 656                                 (format out "~a ~a"
 657                                                 (slot-value loc2 'node-id)
 658                                                 (slot-value loc2 'title))))
 659                         (progn
 660                           (clsql:update-records [node] :av-pairs '(([title] "Altered title"))
 661                                                                         :where [= [node-id] 9])
 662                           (clsql:update-instance-from-records loc2)
 663                           (with-output-to-string (out)
 664                                 (format out "~a ~a"
 665                                                 (slot-value loc2 'node-id)
 666                                                 (slot-value loc2 'title))))
 667                         (progn
 668                           (clsql:update-records [node] :av-pairs '(([title] "location-2"))
 669                                                                         :where [= [node-id] 9])
 670                           (clsql:update-instance-from-records loc2)
 671                           (with-output-to-string (out)
 672                                 (format out "~a ~a"
 673                                                 (slot-value loc2 'node-id)
 674                                                 (slot-value loc2 'title)))))
 675           "9 location-2"
 676           "9 Altered title"
 677           "9 location-2")
 678
 679         (deftest :oodml/update-instance/5
 680             (values
 681              (with-output-to-string (out)
 682                (format out "~a ~a ~a"
 683                        (slot-value subloc2 'subloc-id)
 684                        (slot-value subloc2 'title)
 685                        (slot-value subloc2 'loc)))
 686              (progn
 687                (clsql:update-records [node] :av-pairs '(([title] "Altered title"))
 688                                      :where [= [node-id] 11])
 689                (clsql:update-records [subloc] :av-pairs '(([loc] "Altered loc"))
 690                                      :where [= [subloc-id] 11])
 691                (clsql:update-instance-from-records subloc2)
 692                (with-output-to-string (out)
 693                  (format out "~a ~a ~a"
 694                          (slot-value subloc2 'subloc-id)
 695                          (slot-value subloc2 'title)
 696                          (slot-value subloc2 'loc))))
 697              (progn
 698                (clsql:update-records [node] :av-pairs '(([title] "subloc-2"))
 699                                      :where [= [node-id] 11])
 700                (clsql:update-records [subloc] :av-pairs '(([loc] "second subloc"))
 701                                      :where [= [subloc-id] 11])
 702                (clsql:update-instance-from-records subloc2)
 703                (with-output-to-string (out)
 704                  (format out "~a ~a ~a"
 705                          (slot-value subloc2 'subloc-id)
 706                          (slot-value subloc2 'title)
 707                          (slot-value subloc2 'loc)))))
 708           "11 subloc-2 second subloc"
 709           "11 Altered title Altered loc"
 710           "11 subloc-2 second subloc")
 711
 712         ;; tests update-slot-from-record with normalisedp stuff
 713         (deftest :oodml/update-instance/6
 714             (values
 715              (slot-value theme1 'doc)
 716              (slot-value theme1 'vars)
 717              (progn
 718                (clsql:update-records [theme]
 719                                      :av-pairs '(([doc] "altered doc"))
 720                                      :where [= [theme-id] 6])
 721                (clsql:update-slot-from-record theme1 'doc)
 722                (slot-value theme1 'doc))
 723              (progn
 724                (clsql:update-records [setting]
 725                                      :av-pairs '(([vars] "altered vars"))
 726                                      :where [= [setting-id] 6])
 727                (clsql:update-slot-from-record theme1 'vars)
 728                (slot-value theme1 'vars))
 729              (progn
 730                (clsql:update-records [theme]
 731                                      :av-pairs '(([doc] "first theme"))
 732                                      :where [= [theme-id] 6])
 733                (clsql:update-slot-from-record theme1 'doc)
 734                (slot-value theme1 'doc))
 735              (progn
 736                (clsql:update-records [setting]
 737                                      :av-pairs '(([vars] "empty"))
 738                                      :where [= [setting-id] 6])
 739                (clsql:update-slot-from-record theme1 'vars)
 740                (slot-value theme1 'vars)))
 741          "first theme" "empty"
 742          "altered doc" "altered vars"
 743          "first theme" "empty")
 744
 745         (deftest :oodml/update-instance/7
 746             (values
 747              (slot-value loc2 'title)
 748              (slot-value subloc2 'loc)
 749              (progn
 750                (clsql:update-records [node]
 751                                      :av-pairs '(([title] "altered title"))
 752                                      :where [= [node-id] 9])
 753                (clsql:update-slot-from-record loc2 'title)
 754                (slot-value loc2 'title))
 755              (progn
 756                (clsql:update-records [subloc]
 757                                      :av-pairs '(([loc] "altered loc"))
 758                                      :where [= [subloc-id] 11])
 759                (clsql:update-slot-from-record subloc2 'loc)
 760                (slot-value subloc2 'loc))
 761              (progn
 762                (clsql:update-records [node]
 763                                      :av-pairs '(([title] "location-2"))
 764                                      :where [= [node-id] 9])
 765                (clsql:update-slot-from-record loc2 'title)
 766                (slot-value loc2 'title))
 767              (progn
 768                (clsql:update-records [subloc]
 769                                      :av-pairs '(([loc] "second subloc"))
 770                                      :where [= [subloc-id] 11])
 771                (clsql:update-slot-from-record subloc2 'loc)
 772                (slot-value subloc2 'loc)))
 773          "location-2" "second subloc"
 774                  "altered title" "altered loc"
 775          "location-2" "second subloc")
 776
 777         (deftest :oodml/do-query/1
 778             (let ((result '()))
 779               (clsql:do-query ((e) [select 'employee :order-by [emplid]])
 780                 (push (slot-value e 'last-name) result))
 781               result)
 782           ("Putin" "Yeltsin" "Gorbachev" "Chernenko" "Andropov" "Brezhnev" "Kruschev"
 783            "Trotsky" "Stalin" "Lenin"))
 784
 785         (deftest :oodml/do-query/2
 786             (let ((result '()))
 787               (clsql:do-query ((e c) [select 'employee 'company
 788                                              :where [= [slot-value 'employee 'last-name]
 789                                                        "Lenin"]])
 790                 (push (list (slot-value e 'last-name) (slot-value c 'name))
 791                       result))
 792               result)
 793           (("Lenin" "Widgets Inc.")))
 794
 795         (deftest :oodml/map-query/1
 796             (clsql:map-query 'list #'last-name [select 'employee :order-by [emplid]])
 797           ("Lenin" "Stalin" "Trotsky" "Kruschev" "Brezhnev" "Andropov" "Chernenko"
 798            "Gorbachev" "Yeltsin" "Putin"))
 799
 800         (deftest :oodml/map-query/2
 801             (clsql:map-query 'list #'(lambda (e c) (list (slot-value e 'last-name)
 802                                                          (slot-value c 'name)))
 803              [select 'employee 'company :where [= [slot-value 'employee 'last-name]
 804                                                   "Lenin"]])
 805           (("Lenin" "Widgets Inc.")))
 806
 807         (deftest :oodml/iteration/3
 808             (loop for (e) being the records in
 809              [select 'employee :where [< [emplid] 4] :order-by [emplid]]
 810              collect (slot-value e 'last-name))
 811           ("Lenin" "Stalin" "Trotsky"))
 812
 813
 814       (deftest :oodml/cache/1
 815           (progn
 816             (setf (clsql-sys:record-caches *default-database*) nil)
 817             (let ((employees (select 'employee)))
 818               (every #'(lambda (a b) (eq a b))
 819                      employees (select 'employee))))
 820         t)
 821
 822         (deftest :oodml/cache/2
 823             (let ((employees (select 'employee)))
 824               (equal employees (select 'employee :flatp t)))
 825           nil)
 826
 827         (deftest :oodml/refresh/1
 828             (let ((addresses (select 'address)))
 829               (equal addresses (select 'address :refresh t)))
 830           t)
 831
 832         (deftest :oodml/refresh/2
 833             (let* ((addresses (select 'address :order-by [addressid] :flatp t :refresh t))
 834                    (city (slot-value (car addresses) 'city)))
 835               (clsql:update-records [addr]
 836                               :av-pairs '((city_field "A new city"))
 837                               :where [= [addressid] (slot-value (car addresses) 'addressid)])
 838               (let* ((new-addresses (select 'address :order-by [addressid] :refresh t :flatp t))
 839                      (new-city (slot-value (car addresses) 'city))
 840 )
 841                 (clsql:update-records [addr]
 842                                       :av-pairs `((city_field ,city))
 843                                       :where [= [addressid] (slot-value (car addresses) 'addressid)])
 844                 (values (equal addresses new-addresses)
 845                         city
 846                         new-city)))
 847           t "Leningrad" "A new city")
 848
 849         (deftest :oodml/refresh/3
 850             (let* ((addresses (select 'address :order-by [addressid] :flatp t)))
 851               (values
 852                (equal addresses (select 'address :refresh t :flatp t))
 853                (equal addresses (select 'address :flatp t))))
 854           nil nil)
 855
 856         (deftest :oodml/refresh/4
 857             (let* ((addresses (select 'address :order-by [addressid] :flatp t :refresh t))
 858                    (*db-auto-sync* t))
 859               (make-instance 'address :addressid 1000 :city "A new address city")
 860               (let ((new-addresses (select 'address :order-by [addressid] :flatp t :refresh t)))
 861                 (delete-records :from [addr] :where [= [addressid] 1000])
 862                 (values
 863                  (length addresses)
 864                  (length new-addresses)
 865                  (eq (first addresses) (first new-addresses))
 866                  (eq (second addresses) (second new-addresses)))))
 867           2 3 t t)
 868
 869
 870         (deftest :oodml/uoj/1
 871             (progn
 872               (let* ((dea-list (select 'deferred-employee-address :caching nil :order-by ["ea_join" aaddressid]
 873                                        :flatp t))
 874                      (dea-list-copy (copy-seq dea-list))
 875                      (initially-unbound (every #'(lambda (dea) (not (slot-boundp dea 'address))) dea-list)))
 876                 (update-objects-joins dea-list)
 877                 (values
 878                  initially-unbound
 879                  (equal dea-list dea-list-copy)
 880                  (every #'(lambda (dea) (slot-boundp dea 'address)) dea-list)
 881                  (every #'(lambda (dea) (typep (slot-value dea 'address) 'address)) dea-list)
 882                  (mapcar #'(lambda (dea) (slot-value (slot-value dea 'address) 'addressid)) dea-list))))
 883           t t t t (1 1 2 2 2))
 884
 885         ;; update-object-joins needs to be fixed for multiple keys
 886         #+ignore
 887         (deftest :oodml/uoj/2
 888             (progn
 889               (clsql:update-objects-joins (list company1))
 890               (mapcar #'(lambda (e)
 891                           (slot-value e 'ecompanyid))
 892                  (company-employees company1)))
 893           (1 1 1 1 1 1 1 1 1 1))
 894
 895         (deftest :oodml/big/1
 896             (let ((objs (clsql:select 'big :order-by [i] :flatp t)))
 897               (values
 898                (length objs)
 899                (do ((i 0 (1+ i))
 900                     (max (expt 2 60))
 901                     (rest objs (cdr rest)))
 902                    ((= i (length objs)) t)
 903                  (let ((obj (car rest))
 904                        (index (1+ i)))
 905                    (unless (and (eql (slot-value obj 'i) index)
 906                                 (eql (slot-value obj 'bi) (truncate max index)))
 907                      (print index)
 908                      (describe obj)
 909                      (return nil))))))
 910           555 t)
 911
 912         (deftest :oodml/db-auto-sync/1
 913             (values
 914               (progn
 915                 (make-instance 'employee :emplid 20 :groupid 1
 916                                :last-name "Ivanovich")
 917                 (select [last-name] :from [employee] :where [= [emplid] 20]
 918                         :flatp t :field-names nil))
 919              (let ((*db-auto-sync* t))
 920                (make-instance 'employee :emplid 20 :groupid 1
 921                               :last-name "Ivanovich")
 922                (prog1 (select [last-name] :from [employee] :flatp t
 923                               :field-names nil
 924                               :where [= [emplid] 20])
 925                  (delete-records :from [employee] :where [= [emplid] 20]))))
 926           nil ("Ivanovich"))
 927
 928         (deftest :oodml/db-auto-sync/2
 929             (values
 930              (let ((instance (make-instance 'employee :emplid 20 :groupid 1
 931                                             :last-name "Ivanovich")))
 932                (setf (slot-value instance 'last-name) "Bulgakov")
 933                (select [last-name] :from [employee] :where [= [emplid] 20]
 934                        :flatp t :field-names nil))
 935              (let* ((*db-auto-sync* t)
 936                     (instance (make-instance 'employee :emplid 20 :groupid 1
 937                                              :last-name "Ivanovich")))
 938                (setf (slot-value instance 'last-name) "Bulgakov")
 939                (prog1 (select [last-name] :from [employee] :flatp t
 940                               :field-names nil
 941                               :where [= [emplid] 20])
 942                  (delete-records :from [employee] :where [= [emplid] 20]))))
 943           nil ("Bulgakov"))
 944
 945         (deftest :oodml/db-auto-sync/3
 946             (values
 947               (progn
 948                 (make-instance 'theme :title "test-theme" :vars "test-vars"
 949                                :doc "test-doc")
 950                 (select [node-id] :from [node] :where [= [title] "test-theme"]
 951                         :flatp t :field-names nil))
 952              (let ((*db-auto-sync* t))
 953                 (make-instance 'theme :title "test-theme" :vars "test-vars"
 954                                :doc "test-doc")
 955                 (prog1 (select [title] :from [node] :where [= [title] "test-theme"]
 956                         :flatp t :field-names nil)
 957                   (delete-records :from [node] :where [= [title] "test-theme"])
 958                   (delete-records :from [setting] :where [= [vars] "test-vars"])
 959                   (delete-records :from [theme] :where [= [doc] "test-doc"]))))
 960           nil ("test-theme"))
 961
 962         (deftest :oodml/db-auto-sync/4
 963             (values
 964               (let ((inst (make-instance 'theme
 965                                          :title "test-theme" :vars "test-vars"
 966                                          :doc "test-doc")))
 967                 (setf (slot-value inst 'title) "alternate-test-theme")
 968                 (with-output-to-string (out)
 969                   (format out "~a ~a ~a ~a"
 970                           (select [title] :from [node]
 971                                   :where [= [title] "test-theme"]
 972                                   :flatp t :field-names nil)
 973                           (select [vars] :from [setting]
 974                                   :where [= [vars] "test-vars"]
 975                                   :flatp t :field-names nil)
 976                           (select [doc] :from [theme]
 977                                   :where [= [doc] "test-doc"]
 978                                   :flatp t :field-names nil)
 979                           (select [title] :from [node]
 980                                   :where [= [title] "alternate-test-theme"]
 981                                   :flatp t :field-names nil))))
 982              (let* ((*db-auto-sync* t)
 983                     (inst (make-instance 'theme
 984                                          :title "test-theme" :vars "test-vars"
 985                                          :doc "test-doc")))
 986                 (setf (slot-value inst 'title) "alternate-test-theme")
 987                 (prog1
 988                 (with-output-to-string (out)
 989                   (format out "~a ~a ~a ~a"
 990                           (select [title] :from [node]
 991                                   :where [= [title] "test-theme"]
 992                                   :flatp t :field-names nil)
 993                           (select [vars] :from [setting]
 994                                   :where [= [vars] "test-vars"]
 995                                   :flatp t :field-names nil)
 996                           (select [doc] :from [theme]
 997                                   :where [= [doc] "test-doc"]
 998                                   :flatp t :field-names nil)
 999                           (select [title] :from [node]
1000                                   :where [= [title] "alternate-test-theme"]
1001                                   :flatp t :field-names nil)))
1002                   (delete-records :from [node] :where [= [title] "alternate-test-theme"])
1003                   (delete-records :from [setting] :where [= [vars] "test-vars"])
1004                   (delete-records :from [theme] :where [= [doc] "test-doc"]))))
1005          "NIL NIL NIL NIL"
1006          "NIL (test-vars) (test-doc) (alternate-test-theme)")
1007
1008         (deftest :oodml/setf-slot-value/1
1009             (let* ((*db-auto-sync* t)
1010                    (instance (make-instance 'employee :emplid 20 :groupid 1)))
1011               (prog1
1012                   (setf
1013                    (slot-value instance 'first-name) "Mikhail"
1014                    (slot-value instance 'last-name) "Bulgakov")
1015                 (delete-records :from [employee] :where [= [emplid] 20])))
1016           "Bulgakov")
1017
1018         (deftest :oodml/float/1
1019             (let* ((emp1 (car (select 'employee
1020                                       :where [= [slot-value 'employee 'emplid]
1021                                                 1]
1022                                       :flatp t
1023                                       :caching nil)))
1024                    (height (slot-value emp1 'height)))
1025               (prog1
1026                   (progn
1027                     (setf (slot-value emp1 'height) 1.0E0)
1028                     (clsql:update-record-from-slot emp1 'height)
1029                     (= (car (clsql:select [height] :from [employee]
1030                                           :where [= [emplid] 1]
1031                                           :flatp t
1032                                           :field-names nil))
1033                        1))
1034                 (setf (slot-value emp1 'height) height)
1035                 (clsql:update-record-from-slot emp1 'height)))
1036          t)
1037
1038         (deftest :oodml/float/2
1039             (let* ((emp1 (car (select 'employee
1040                                      :where [= [slot-value 'employee 'emplid]
1041                                                1]
1042                                      :flatp t
1043                                      :caching nil)))
1044                    (height (slot-value emp1 'height)))
1045               (prog1
1046                   (progn
1047                     (setf (slot-value emp1 'height) 1.0S0)
1048                     (clsql:update-record-from-slot emp1 'height)
1049                     (= (car (clsql:select [height] :from [employee]
1050                                           :where [= [emplid] 1]
1051                                           :flatp t
1052                                           :field-names nil))
1053                        1))
1054                 (setf (slot-value emp1 'height) height)
1055                 (clsql:update-record-from-slot emp1 'height)))
1056          t)
1057
1058         (deftest :oodml/float/3
1059             (let* ((emp1 (car (select 'employee
1060                                      :where [= [slot-value 'employee 'emplid]
1061                                                1]
1062                                      :flatp t
1063                                      :caching nil)))
1064                    (height (slot-value emp1 'height)))
1065               (prog1
1066                   (progn
1067                     (setf (slot-value emp1 'height) 1.0F0)
1068                     (clsql:update-record-from-slot emp1 'height)
1069                     (= (car (clsql:select [height] :from [employee]
1070                                           :where [= [emplid] 1]
1071                                           :flatp t
1072                                           :field-names nil))
1073                        1))
1074                 (setf (slot-value emp1 'height) height)
1075                 (clsql:update-record-from-slot emp1 'height)))
1076           t)
1077
1078         (deftest :oodml/float/4
1079             (let* ((emp1 (car (select 'employee
1080                                      :where [= [slot-value 'employee 'emplid]
1081                                                1]
1082                                      :flatp t
1083                                      :caching nil)))
1084                    (height (slot-value emp1 'height)))
1085               (prog1
1086                   (progn
1087                     (setf (slot-value emp1 'height) 1.0D0)
1088                     (clsql:update-record-from-slot emp1 'height)
1089                     (= (car (clsql:select [height] :from [employee]
1090                                           :where [= [emplid] 1]
1091                                           :flatp t
1092                                           :field-names nil))
1093                        1))
1094                 (setf (slot-value emp1 'height) height)
1095                 (clsql:update-record-from-slot emp1 'height)))
1096          t)
1097
1098         (deftest :oodml/float/5
1099             (let* ((emp1 (car (select 'employee
1100                                       :where [= [slot-value 'employee 'emplid]
1101                                                 1]
1102                                       :flatp t
1103                                       :caching nil)))
1104                    (height (slot-value emp1 'height)))
1105               (prog1
1106                   (progn
1107                     (setf (slot-value emp1 'height) 1.0L0)
1108                     (clsql:update-record-from-slot emp1 'height)
1109                     (= (car (clsql:select [height] :from [employee]
1110                                           :where [= [emplid] 1]
1111                                           :flatp t
1112                                           :field-names nil))
1113                        1))
1114                 (setf (slot-value emp1 'height) height)
1115                 (clsql:update-record-from-slot emp1 'height)))
1116          t)))
1117
1118
1119
1120 #.(clsql:restore-sql-reader-syntax-state)