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         ;; :retrieval :immediate should be boundp before accessed
 115         (deftest :oodm/retrieval/2
 116             (every #'(lambda (ea) (slot-boundp ea 'address))
 117              (select 'employee-address :flatp t :caching nil))
 118           t)
 119
 120         (deftest :oodm/retrieval/3
 121             (mapcar #'(lambda (ea) (typep (slot-value ea 'address) 'address))
 122              (select 'employee-address :flatp t :caching nil))
 123           (t t t t t))
 124
 125         (deftest :oodm/retrieval/4
 126             (every #'(lambda (ea) (slot-boundp (slot-value ea 'address) 'addressid))
 127              (select 'employee-address :flatp t :caching nil))
 128           t)
 129
 130         (deftest :oodm/retrieval/5
 131             (mapcar #'(lambda (ea) (slot-value (slot-value ea 'address) 'street-number))
 132              (select 'employee-address :flatp t :order-by [aaddressid] :caching nil))
 133           (10 10 nil nil nil))
 134
 135         ;; tests update-records-from-instance
 136         (deftest :oodml/update-records/1
 137             (values
 138              (progn
 139                (let ((lenin (car (clsql:select 'employee
 140                                                :where [= [slot-value 'employee 'emplid]
 141                                                          1]
 142                                                :flatp t
 143                                                :caching nil))))
 144                  (concatenate 'string
 145                               (first-name lenin)
 146                               " "
 147                               (last-name lenin)
 148                               ": "
 149                               (employee-email lenin))))
 150              (progn
 151                (setf (slot-value employee1 'first-name) "Dimitriy"
 152                      (slot-value employee1 'last-name) "Ivanovich"
 153                      (slot-value employee1 'email) "ivanovich@soviet.org")
 154                (clsql:update-records-from-instance employee1)
 155                (let ((lenin (car (clsql:select 'employee
 156                                                :where [= [slot-value 'employee 'emplid]
 157                                                          1]
 158                                                :flatp t
 159                                                :caching nil))))
 160                  (concatenate 'string
 161                               (first-name lenin)
 162                               " "
 163                               (last-name lenin)
 164                               ": "
 165                               (employee-email lenin))))
 166              (progn
 167                (setf (slot-value employee1 'first-name) "Vladamir"
 168                      (slot-value employee1 'last-name) "Lenin"
 169                      (slot-value employee1 'email) "lenin@soviet.org")
 170                (clsql:update-records-from-instance employee1)
 171                (let ((lenin (car (clsql:select 'employee
 172                                                :where [= [slot-value 'employee 'emplid]
 173                                                          1]
 174                                                :flatp t
 175                                                :caching nil))))
 176                  (concatenate 'string
 177                               (first-name lenin)
 178                               " "
 179                               (last-name lenin)
 180                               ": "
 181                               (employee-email lenin)))))
 182           "Vladamir Lenin: lenin@soviet.org"
 183           "Dimitriy Ivanovich: ivanovich@soviet.org"
 184           "Vladamir Lenin: lenin@soviet.org")
 185
 186         ;; tests update-record-from-slot
 187         (deftest :oodml/update-records/2
 188             (values
 189              (employee-email
 190               (car (clsql:select 'employee
 191                                  :where [= [slot-value 'employee 'emplid] 1]
 192                                  :flatp t
 193                                  :caching nil)))
 194              (progn
 195                (setf (slot-value employee1 'email) "lenin-nospam@soviet.org")
 196                (clsql:update-record-from-slot employee1 'email)
 197                (employee-email
 198                 (car (clsql:select 'employee
 199                                    :where [= [slot-value 'employee 'emplid] 1]
 200                                    :flatp t
 201                                    :caching nil))))
 202              (progn
 203                (setf (slot-value employee1 'email) "lenin@soviet.org")
 204                (clsql:update-record-from-slot employee1 'email)
 205                (employee-email
 206                 (car (clsql:select 'employee
 207                                    :where [= [slot-value 'employee 'emplid] 1]
 208                                    :flatp t
 209                                    :caching nil)))))
 210           "lenin@soviet.org" "lenin-nospam@soviet.org" "lenin@soviet.org")
 211
 212         ;; tests update-record-from-slots
 213         (deftest :oodml/update-records/3
 214             (values
 215              (let ((lenin (car (clsql:select 'employee
 216                                              :where [= [slot-value 'employee 'emplid]
 217                                                        1]
 218                                              :flatp t
 219                                              :caching nil))))
 220                (concatenate 'string
 221                             (first-name lenin)
 222                             " "
 223                             (last-name lenin)
 224                             ": "
 225                             (employee-email lenin)))
 226              (progn
 227                (setf (slot-value employee1 'first-name) "Dimitriy"
 228                      (slot-value employee1 'last-name) "Ivanovich"
 229                      (slot-value employee1 'email) "ivanovich@soviet.org")
 230                (clsql:update-record-from-slots employee1 '(first-name last-name email))
 231                (let ((lenin (car (clsql:select 'employee
 232                                                :where [= [slot-value 'employee 'emplid]
 233                                                          1]
 234                                                :flatp t
 235                                                :caching nil))))
 236                  (concatenate 'string
 237                               (first-name lenin)
 238                               " "
 239                               (last-name lenin)
 240                               ": "
 241                               (employee-email lenin))))
 242              (progn
 243                (setf (slot-value employee1 'first-name) "Vladamir"
 244                      (slot-value employee1 'last-name) "Lenin"
 245                      (slot-value employee1 'email) "lenin@soviet.org")
 246                (clsql:update-record-from-slots employee1 '(first-name last-name email))
 247                (let ((lenin (car (clsql:select 'employee
 248                                                :where [= [slot-value 'employee 'emplid]
 249                                                          1]
 250                                                :flatp t
 251                                                :caching nil))))
 252                  (concatenate 'string
 253                               (first-name lenin)
 254                               " "
 255                               (last-name lenin)
 256                               ": "
 257                               (employee-email lenin)))))
 258           "Vladamir Lenin: lenin@soviet.org"
 259           "Dimitriy Ivanovich: ivanovich@soviet.org"
 260           "Vladamir Lenin: lenin@soviet.org")
 261
 262         ;; tests update-instance-from-records
 263         (deftest :oodml/update-instance/1
 264             (values
 265              (concatenate 'string
 266                           (slot-value employee1 'first-name)
 267                           " "
 268                           (slot-value employee1 'last-name)
 269                           ": "
 270                           (slot-value employee1 'email))
 271              (progn
 272                (clsql:update-records [employee]
 273                                      :av-pairs '(([first-name] "Ivan")
 274                                                  ([last-name] "Petrov")
 275                                                  ([email] "petrov@soviet.org"))
 276                                      :where [= [emplid] 1])
 277                (clsql:update-instance-from-records employee1)
 278                (concatenate 'string
 279                             (slot-value employee1 'first-name)
 280                             " "
 281                             (slot-value employee1 'last-name)
 282                             ": "
 283                             (slot-value employee1 'email)))
 284              (progn
 285                (clsql:update-records [employee]
 286                                      :av-pairs '(([first-name] "Vladamir")
 287                                                  ([last-name] "Lenin")
 288                                                  ([email] "lenin@soviet.org"))
 289                                      :where [= [emplid] 1])
 290                (clsql:update-instance-from-records employee1)
 291                (concatenate 'string
 292                             (slot-value employee1 'first-name)
 293                             " "
 294                             (slot-value employee1 'last-name)
 295                             ": "
 296                             (slot-value employee1 'email))))
 297           "Vladamir Lenin: lenin@soviet.org"
 298           "Ivan Petrov: petrov@soviet.org"
 299           "Vladamir Lenin: lenin@soviet.org")
 300
 301         ;; tests update-slot-from-record
 302         (deftest :oodml/update-instance/2
 303             (values
 304              (slot-value employee1 'email)
 305              (progn
 306                (clsql:update-records [employee]
 307                                      :av-pairs '(([email] "lenin-nospam@soviet.org"))
 308                                      :where [= [emplid] 1])
 309                (clsql:update-slot-from-record employee1 'email)
 310                (slot-value employee1 'email))
 311              (progn
 312                (clsql:update-records [employee]
 313                                      :av-pairs '(([email] "lenin@soviet.org"))
 314                                      :where [= [emplid] 1])
 315                (clsql:update-slot-from-record employee1 'email)
 316                (slot-value employee1 'email)))
 317           "lenin@soviet.org" "lenin-nospam@soviet.org" "lenin@soviet.org")
 318
 319
 320         (deftest :oodml/do-query/1
 321             (let ((result '()))
 322               (clsql:do-query ((e) [select 'employee :order-by [emplid]])
 323                 (push (slot-value e 'last-name) result))
 324               result)
 325           ("Putin" "Yeltsin" "Gorbachev" "Chernenko" "Andropov" "Brezhnev" "Kruschev"
 326            "Trotsky" "Stalin" "Lenin"))
 327
 328         (deftest :oodml/do-query/2
 329             (let ((result '()))
 330               (clsql:do-query ((e c) [select 'employee 'company
 331                                              :where [= [slot-value 'employee 'last-name]
 332                                                        "Lenin"]])
 333                 (push (list (slot-value e 'last-name) (slot-value c 'name))
 334                       result))
 335               result)
 336           (("Lenin" "Widgets Inc.")))
 337
 338         (deftest :oodml/map-query/1
 339             (clsql:map-query 'list #'last-name [select 'employee :order-by [emplid]])
 340           ("Lenin" "Stalin" "Trotsky" "Kruschev" "Brezhnev" "Andropov" "Chernenko"
 341            "Gorbachev" "Yeltsin" "Putin"))
 342
 343         (deftest :oodml/map-query/2
 344             (clsql:map-query 'list #'(lambda (e c) (list (slot-value e 'last-name)
 345                                                          (slot-value c 'name)))
 346              [select 'employee 'company :where [= [slot-value 'employee 'last-name]
 347                                                   "Lenin"]])
 348           (("Lenin" "Widgets Inc.")))
 349
 350         (deftest :oodml/iteration/3
 351             (loop for (e) being the records in
 352              [select 'employee :where [< [emplid] 4] :order-by [emplid]]
 353              collect (slot-value e 'last-name))
 354           ("Lenin" "Stalin" "Trotsky"))
 355
 356         ))
 357
 358 #.(clsql:restore-sql-reader-syntax-state)