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 ;;;; Updated: $Id$
   7 ;;;;
   8 ;;;; Tests for the CLSQL Object Oriented Data Definition Language
   9 ;;;; (OODML).
  10 ;;;;
  11 ;;;; This file is part of CLSQL.
  12 ;;;;
  13 ;;;; CLSQL users are granted the rights to distribute and use this software
  14 ;;;; as governed by the terms of the Lisp Lesser GNU Public License
  15 ;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL.
  16 ;;;; ======================================================================
  17
  18 (in-package #:clsql-tests)
  19
  20 #.(clsql:locally-enable-sql-reader-syntax)
  21
  22 (setq *rt-oodml*
  23       '(
  24
  25         (deftest :oodml/select/1
  26             (mapcar #'(lambda (e) (slot-value e 'last-name))
  27              (clsql:select 'employee :order-by [last-name] :flatp t :caching nil))
  28           ("Andropov" "Brezhnev" "Chernenko" "Gorbachev" "Kruschev" "Lenin" "Putin"
  29            "Stalin" "Trotsky" "Yeltsin"))
  30
  31         (deftest :oodml/select/2
  32             (mapcar #'(lambda (e) (slot-value e 'name))
  33              (clsql:select 'company :flatp t :caching nil))
  34           ("Widgets Inc."))
  35
  36         (deftest :oodml/select/3
  37             (mapcar #'(lambda (e) (slot-value e 'ecompanyid))
  38              (clsql:select 'employee
  39                            :where [and [= [slot-value 'employee 'ecompanyid]
  40                                           [slot-value 'company 'companyid]]
  41                                        [= [slot-value 'company 'name]
  42                                           "Widgets Inc."]]
  43                            :flatp t
  44                            :caching nil))
  45           (1 1 1 1 1 1 1 1 1 1))
  46
  47         (deftest :oodml/select/4
  48             (mapcar #'(lambda (e)
  49                         (concatenate 'string (slot-value e 'first-name)
  50                                      " "
  51                                      (slot-value e 'last-name)))
  52              (clsql:select 'employee :where [= [slot-value 'employee 'first-name]
  53                                                "Vladamir"]
  54                            :flatp t
  55                            :order-by [last-name]
  56                            :caching nil))
  57           ("Vladamir Lenin" "Vladamir Putin"))
  58
  59         (deftest :oodml/select/5
  60             (length (clsql:select 'employee :where [married] :flatp t :caching nil))
  61           3)
  62
  63         (deftest :oodml/select/6
  64             (let ((a (caar (clsql:select 'address :where [= 1 [addressid]] :caching nil))))
  65               (values
  66                (slot-value a 'street-number)
  67                (slot-value a 'street-name)
  68                (slot-value a 'city)
  69                (slot-value a 'postal-code)))
  70           10 "Park Place" "Leningrad" 123)
  71
  72         (deftest :oodml/select/7
  73             (let ((a (caar (clsql:select 'address :where [= 2 [addressid]] :caching nil))))
  74               (values
  75                (slot-value a 'street-number)
  76                (slot-value a 'street-name)
  77                (slot-value a 'city)
  78                (slot-value a 'postal-code)))
  79           nil "" "no city" 0)
  80
  81         (deftest :oodml/select/8
  82             (mapcar #'(lambda (e) (slot-value e 'married))
  83              (clsql:select 'employee :flatp t :order-by [emplid] :caching nil))
  84           (t t t nil nil nil nil nil nil nil))
  85
  86         (deftest :oodml/select/9
  87             (mapcar #'(lambda (pair)
  88                         (list
  89                          (typep (car pair) 'address)
  90                          (typep (second pair) 'employee-address)
  91                          (slot-value (car pair) 'addressid)
  92                          (slot-value (second pair) 'aaddressid)
  93                          (slot-value (second pair) 'aemplid)))
  94              (employee-addresses employee1))
  95           ((t t 1 1 1) (t t 2 2 1)))
  96
  97         (deftest :oodml/select/10
  98             (mapcar #'(lambda (pair)
  99                         (list
 100                          (typep (car pair) 'address)
 101                          (typep (second pair) 'employee-address)
 102                          (slot-value (car pair) 'addressid)
 103                          (slot-value (second pair) 'aaddressid)
 104                          (slot-value (second pair) 'aemplid)))
 105              (employee-addresses employee2))
 106           ((t t 2 2 2)))
 107
 108         ;; test retrieval is deferred
 109         (deftest :oodm/retrieval/1
 110             (every #'(lambda (e) (not (slot-boundp e 'company)))
 111              (select 'employee :flatp t :caching nil))
 112           t)
 113
 114         (deftest :oodm/retrieval/2
 115             (every #'(lambda (e) (not (slot-boundp e 'address)))
 116              (select 'deferred-employee-address :flatp t :caching nil))
 117           t)
 118
 119         ;; :retrieval :immediate should be boundp before accessed
 120         (deftest :oodm/retrieval/3
 121             (every #'(lambda (ea) (slot-boundp ea 'address))
 122              (select 'employee-address :flatp t :caching nil))
 123           t)
 124
 125         (deftest :oodm/retrieval/4
 126             (mapcar #'(lambda (ea) (typep (slot-value ea 'address) 'address))
 127              (select 'employee-address :flatp t :caching nil))
 128           (t t t t t))
 129
 130         (deftest :oodm/retrieval/5
 131             (mapcar #'(lambda (ea) (typep (slot-value ea 'address) 'address))
 132              (select 'deferred-employee-address :flatp t :caching nil))
 133           (t t t t t))
 134
 135         (deftest :oodm/retrieval/6
 136             (every #'(lambda (ea) (slot-boundp (slot-value ea 'address) 'addressid))
 137              (select 'employee-address :flatp t :caching nil))
 138           t)
 139
 140         (deftest :oodm/retrieval/7
 141             (every #'(lambda (ea) (slot-boundp (slot-value ea 'address) 'addressid))
 142              (select 'deferred-employee-address :flatp t :caching nil))
 143           t)
 144
 145         (deftest :oodm/retrieval/8
 146             (mapcar #'(lambda (ea) (slot-value (slot-value ea 'address) 'street-number))
 147              (select 'employee-address :flatp t :order-by [aaddressid] :caching nil))
 148           (10 10 nil nil nil))
 149
 150         (deftest :oodm/retrieval/9
 151             (mapcar #'(lambda (ea) (slot-value (slot-value ea 'address) 'street-number))
 152              (select 'deferred-employee-address :flatp t :order-by [aaddressid] :caching nil))
 153           (10 10 nil nil nil))
 154
 155         ;; tests update-records-from-instance
 156         (deftest :oodml/update-records/1
 157             (values
 158              (progn
 159                (let ((lenin (car (clsql:select 'employee
 160                                                :where [= [slot-value 'employee 'emplid]
 161                                                          1]
 162                                                :flatp t
 163                                                :caching nil))))
 164                  (concatenate 'string
 165                               (first-name lenin)
 166                               " "
 167                               (last-name lenin)
 168                               ": "
 169                               (employee-email lenin))))
 170              (progn
 171                (setf (slot-value employee1 'first-name) "Dimitriy"
 172                      (slot-value employee1 'last-name) "Ivanovich"
 173                      (slot-value employee1 'email) "ivanovich@soviet.org")
 174                (clsql:update-records-from-instance employee1)
 175                (let ((lenin (car (clsql:select 'employee
 176                                                :where [= [slot-value 'employee 'emplid]
 177                                                          1]
 178                                                :flatp t
 179                                                :caching nil))))
 180                  (concatenate 'string
 181                               (first-name lenin)
 182                               " "
 183                               (last-name lenin)
 184                               ": "
 185                               (employee-email lenin))))
 186              (progn
 187                (setf (slot-value employee1 'first-name) "Vladamir"
 188                      (slot-value employee1 'last-name) "Lenin"
 189                      (slot-value employee1 'email) "lenin@soviet.org")
 190                (clsql:update-records-from-instance employee1)
 191                (let ((lenin (car (clsql:select 'employee
 192                                                :where [= [slot-value 'employee 'emplid]
 193                                                          1]
 194                                                :flatp t
 195                                                :caching nil))))
 196                  (concatenate 'string
 197                               (first-name lenin)
 198                               " "
 199                               (last-name lenin)
 200                               ": "
 201                               (employee-email lenin)))))
 202           "Vladamir Lenin: lenin@soviet.org"
 203           "Dimitriy Ivanovich: ivanovich@soviet.org"
 204           "Vladamir Lenin: lenin@soviet.org")
 205
 206         ;; tests update-record-from-slot
 207         (deftest :oodml/update-records/2
 208             (values
 209              (employee-email
 210               (car (clsql:select 'employee
 211                                  :where [= [slot-value 'employee 'emplid] 1]
 212                                  :flatp t
 213                                  :caching nil)))
 214              (progn
 215                (setf (slot-value employee1 'email) "lenin-nospam@soviet.org")
 216                (clsql:update-record-from-slot employee1 'email)
 217                (employee-email
 218                 (car (clsql:select 'employee
 219                                    :where [= [slot-value 'employee 'emplid] 1]
 220                                    :flatp t
 221                                    :caching nil))))
 222              (progn
 223                (setf (slot-value employee1 'email) "lenin@soviet.org")
 224                (clsql:update-record-from-slot employee1 'email)
 225                (employee-email
 226                 (car (clsql:select 'employee
 227                                    :where [= [slot-value 'employee 'emplid] 1]
 228                                    :flatp t
 229                                    :caching nil)))))
 230           "lenin@soviet.org" "lenin-nospam@soviet.org" "lenin@soviet.org")
 231
 232         ;; tests update-record-from-slots
 233         (deftest :oodml/update-records/3
 234             (values
 235              (let ((lenin (car (clsql:select 'employee
 236                                              :where [= [slot-value 'employee 'emplid]
 237                                                        1]
 238                                              :flatp t
 239                                              :caching nil))))
 240                (concatenate 'string
 241                             (first-name lenin)
 242                             " "
 243                             (last-name lenin)
 244                             ": "
 245                             (employee-email lenin)))
 246              (progn
 247                (setf (slot-value employee1 'first-name) "Dimitriy"
 248                      (slot-value employee1 'last-name) "Ivanovich"
 249                      (slot-value employee1 'email) "ivanovich@soviet.org")
 250                (clsql:update-record-from-slots employee1 '(first-name last-name email))
 251                (let ((lenin (car (clsql:select 'employee
 252                                                :where [= [slot-value 'employee 'emplid]
 253                                                          1]
 254                                                :flatp t
 255                                                :caching nil))))
 256                  (concatenate 'string
 257                               (first-name lenin)
 258                               " "
 259                               (last-name lenin)
 260                               ": "
 261                               (employee-email lenin))))
 262              (progn
 263                (setf (slot-value employee1 'first-name) "Vladamir"
 264                      (slot-value employee1 'last-name) "Lenin"
 265                      (slot-value employee1 'email) "lenin@soviet.org")
 266                (clsql:update-record-from-slots employee1 '(first-name last-name email))
 267                (let ((lenin (car (clsql:select 'employee
 268                                                :where [= [slot-value 'employee 'emplid]
 269                                                          1]
 270                                                :flatp t
 271                                                :caching nil))))
 272                  (concatenate 'string
 273                               (first-name lenin)
 274                               " "
 275                               (last-name lenin)
 276                               ": "
 277                               (employee-email lenin)))))
 278           "Vladamir Lenin: lenin@soviet.org"
 279           "Dimitriy Ivanovich: ivanovich@soviet.org"
 280           "Vladamir Lenin: lenin@soviet.org")
 281
 282         ;; tests update-instance-from-records
 283         (deftest :oodml/update-instance/1
 284             (values
 285              (concatenate 'string
 286                           (slot-value employee1 'first-name)
 287                           " "
 288                           (slot-value employee1 'last-name)
 289                           ": "
 290                           (slot-value employee1 'email))
 291              (progn
 292                (clsql:update-records [employee]
 293                                      :av-pairs '(([first-name] "Ivan")
 294                                                  ([last-name] "Petrov")
 295                                                  ([email] "petrov@soviet.org"))
 296                                      :where [= [emplid] 1])
 297                (clsql:update-instance-from-records employee1)
 298                (concatenate 'string
 299                             (slot-value employee1 'first-name)
 300                             " "
 301                             (slot-value employee1 'last-name)
 302                             ": "
 303                             (slot-value employee1 'email)))
 304              (progn
 305                (clsql:update-records [employee]
 306                                      :av-pairs '(([first-name] "Vladamir")
 307                                                  ([last-name] "Lenin")
 308                                                  ([email] "lenin@soviet.org"))
 309                                      :where [= [emplid] 1])
 310                (clsql:update-instance-from-records employee1)
 311                (concatenate 'string
 312                             (slot-value employee1 'first-name)
 313                             " "
 314                             (slot-value employee1 'last-name)
 315                             ": "
 316                             (slot-value employee1 'email))))
 317           "Vladamir Lenin: lenin@soviet.org"
 318           "Ivan Petrov: petrov@soviet.org"
 319           "Vladamir Lenin: lenin@soviet.org")
 320
 321         ;; tests update-slot-from-record
 322         (deftest :oodml/update-instance/2
 323             (values
 324              (slot-value employee1 'email)
 325              (progn
 326                (clsql:update-records [employee]
 327                                      :av-pairs '(([email] "lenin-nospam@soviet.org"))
 328                                      :where [= [emplid] 1])
 329                (clsql:update-slot-from-record employee1 'email)
 330                (slot-value employee1 'email))
 331              (progn
 332                (clsql:update-records [employee]
 333                                      :av-pairs '(([email] "lenin@soviet.org"))
 334                                      :where [= [emplid] 1])
 335                (clsql:update-slot-from-record employee1 'email)
 336                (slot-value employee1 'email)))
 337           "lenin@soviet.org" "lenin-nospam@soviet.org" "lenin@soviet.org")
 338
 339
 340         (deftest :oodml/do-query/1
 341             (let ((result '()))
 342               (clsql:do-query ((e) [select 'employee :order-by [emplid]])
 343                 (push (slot-value e 'last-name) result))
 344               result)
 345           ("Putin" "Yeltsin" "Gorbachev" "Chernenko" "Andropov" "Brezhnev" "Kruschev"
 346            "Trotsky" "Stalin" "Lenin"))
 347
 348         (deftest :oodml/do-query/2
 349             (let ((result '()))
 350               (clsql:do-query ((e c) [select 'employee 'company
 351                                              :where [= [slot-value 'employee 'last-name]
 352                                                        "Lenin"]])
 353                 (push (list (slot-value e 'last-name) (slot-value c 'name))
 354                       result))
 355               result)
 356           (("Lenin" "Widgets Inc.")))
 357
 358         (deftest :oodml/map-query/1
 359             (clsql:map-query 'list #'last-name [select 'employee :order-by [emplid]])
 360           ("Lenin" "Stalin" "Trotsky" "Kruschev" "Brezhnev" "Andropov" "Chernenko"
 361            "Gorbachev" "Yeltsin" "Putin"))
 362
 363         (deftest :oodml/map-query/2
 364             (clsql:map-query 'list #'(lambda (e c) (list (slot-value e 'last-name)
 365                                                          (slot-value c 'name)))
 366              [select 'employee 'company :where [= [slot-value 'employee 'last-name]
 367                                                   "Lenin"]])
 368           (("Lenin" "Widgets Inc.")))
 369
 370         (deftest :oodml/iteration/3
 371             (loop for (e) being the records in
 372              [select 'employee :where [< [emplid] 4] :order-by [emplid]]
 373              collect (slot-value e 'last-name))
 374           ("Lenin" "Stalin" "Trotsky"))
 375
 376
 377       (deftest oodml/cache/1
 378           (progn
 379             (setf (clsql-sys:record-caches *default-database*) nil)
 380             (let ((employees (select 'employee)))
 381               (every #'(lambda (a b) (eq a b))
 382                      employees (select 'employee))))
 383         t)
 384
 385         (deftest oodml/cache/2
 386             (let ((employees (select 'employee)))
 387               (equal employees (select 'employee :flatp t)))
 388           nil)
 389
 390         (deftest oodml/refresh/1
 391             (let ((addresses (select 'address)))
 392               (equal addresses (select 'address :refresh t)))
 393           t)
 394
 395         (deftest oodml/refresh/2
 396             (let* ((addresses (select 'address :order-by [addressid] :flatp t))
 397                    (city (slot-value (car addresses) 'city)))
 398               (clsql:update-records [addr]
 399                               :av-pairs '((city_field "A new city"))
 400                               :where [= [addressid] (slot-value (car addresses) 'addressid)])
 401               (let* ((new-addresses (select 'address :order-by [addressid] :refresh t :flatp t))
 402                      (new-city (slot-value (car addresses) 'city))
 403 )
 404                 (clsql:update-records [addr]
 405                                       :av-pairs `((city_field ,city))
 406                                       :where [= [addressid] (slot-value (car addresses) 'addressid)])
 407                 (values (equal addresses new-addresses)
 408                         city
 409                         new-city)))
 410           t "Leningrad" "A new city")
 411
 412         (deftest oodml/refresh/3
 413             (let* ((addresses (select 'address :order-by [addressid] :flatp t)))
 414               (values
 415                (equal addresses (select 'address :refresh t :flatp t))
 416                (equal addresses (select 'address :flatp t))))
 417           nil nil)
 418
 419         (deftest oodml/refresh/4
 420             (let* ((addresses (select 'address :order-by [addressid] :flatp t))
 421                    (*db-auto-sync* t))
 422               (make-instance 'address :addressid 1000 :city "A new address city")
 423               (let ((new-addresses (select 'address :order-by [addressid] :flatp t :refresh t)))
 424                 (delete-records :from [addr] :where [= [addressid] 1000])
 425                 (values
 426                  (length addresses)
 427                  (length new-addresses)
 428                  (eq (first addresses) (first new-addresses))
 429                  (eq (second addresses) (second new-addresses)))))
 430           2 3 t t)
 431
 432
 433         (deftest oodml/uoj/1
 434             (progn
 435               (let* ((dea-list (select 'deferred-employee-address :caching nil :order-by [ea_join aaddressid]
 436                                        :flatp t))
 437                      (dea-list-copy (copy-seq dea-list))
 438                      (initially-unbound (every #'(lambda (dea) (not (slot-boundp dea 'address))) dea-list)))
 439                 (update-object-joins dea-list)
 440                 (values
 441                  initially-unbound
 442                  (equal dea-list dea-list-copy)
 443                  (every #'(lambda (dea) (slot-boundp dea 'address)) dea-list)
 444                  (every #'(lambda (dea) (typep (slot-value dea 'address) 'address)) dea-list)
 445                  (mapcar #'(lambda (dea) (slot-value (slot-value dea 'address) 'addressid)) dea-list))))
 446           t t t t (1 1 2 2 2))
 447         ))
 448 #.(clsql:restore-sql-reader-syntax-state)