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))
  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))
  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           (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                                                "Vladamir"]
  53                            :flatp t
  54                            :order-by [last-name]))
  55           ("Vladamir Lenin" "Vladamir Putin"))
  56
  57         (deftest :oodml/select/5
  58             (length (clsql:select 'employee :where [married] :flatp t))
  59           3)
  60
  61         (deftest :oodml/select/6
  62             (let ((a (caar (clsql:select 'address :where [= 1 [addressid]]))))
  63               (values
  64                (slot-value a 'street-number)
  65                (slot-value a 'street-name)
  66                (slot-value a 'city)
  67                (slot-value a 'postal-code)))
  68           10 "Park Place" "Leningrad" 123)
  69
  70         (deftest :oodml/select/7
  71             (let ((a (caar (clsql:select 'address :where [= 2 [addressid]]))))
  72               (values
  73                (slot-value a 'street-number)
  74                (slot-value a 'street-name)
  75                (slot-value a 'city)
  76                (slot-value a 'postal-code)))
  77           nil "" "no city" 0)
  78
  79         (deftest :oodml/select/8
  80             (mapcar #'(lambda (e) (slot-value e 'married))
  81              (clsql:select 'employee :flatp t :order-by [emplid]))
  82           (t t t nil nil nil nil nil nil nil))
  83
  84         (deftest :oodml/select/9
  85             (mapcar #'(lambda (pair)
  86                         (list
  87                          (typep (car pair) 'address)
  88                          (typep (second pair) 'employee-address)
  89                          (slot-value (car pair) 'addressid)
  90                          (slot-value (second pair) 'aaddressid)
  91                          (slot-value (second pair) 'aemplid)))
  92              (employee-addresses employee1))
  93           ((t t 1 1 1) (t t 2 2 1)))
  94
  95         (deftest :oodml/select/10
  96             (mapcar #'(lambda (pair)
  97                         (list
  98                          (typep (car pair) 'address)
  99                          (typep (second pair) 'employee-address)
 100                          (slot-value (car pair) 'addressid)
 101                          (slot-value (second pair) 'aaddressid)
 102                          (slot-value (second pair) 'aemplid)))
 103              (employee-addresses employee2))
 104           ((t t 2 2 2)))
 105
 106         ;; test retrieval is deferred
 107         (deftest :oodm/retrieval/1
 108             (every #'(lambda (e) (not (slot-boundp e 'company)))
 109              (select 'employee :flatp t))
 110           t)
 111
 112         ;; :retrieval :immediate should be boundp before accessed
 113         (deftest :oodm/retrieval/2
 114             (every #'(lambda (ea) (slot-boundp ea 'address))
 115              (select 'employee-address :flatp t))
 116           t)
 117
 118         (deftest :oodm/retrieval/3
 119             (mapcar #'(lambda (ea) (typep (slot-value ea 'address) 'address))
 120              (select 'employee-address :flatp t))
 121           (t t t t t))
 122
 123         (deftest :oodm/retrieval/4
 124             (every #'(lambda (ea) (slot-boundp (slot-value ea 'address) 'addressid))
 125              (select 'employee-address :flatp t))
 126           t)
 127
 128         (deftest :oodm/retrieval/5
 129             (mapcar #'(lambda (ea) (slot-value (slot-value ea 'address) 'street-number))
 130              (select 'employee-address :flatp t :order-by [aaddressid]))
 131           (10 10 nil nil nil))
 132
 133         ;; tests update-records-from-instance
 134         (deftest :oodml/update-records/1
 135             (values
 136              (progn
 137                (let ((lenin (car (clsql:select 'employee
 138                                                :where [= [slot-value 'employee 'emplid]
 139                                                          1]
 140                                                :flatp t))))
 141                  (concatenate 'string
 142                               (first-name lenin)
 143                               " "
 144                               (last-name lenin)
 145                               ": "
 146                               (employee-email lenin))))
 147              (progn
 148                (setf (slot-value employee1 'first-name) "Dimitriy"
 149                      (slot-value employee1 'last-name) "Ivanovich"
 150                      (slot-value employee1 'email) "ivanovich@soviet.org")
 151                (clsql:update-records-from-instance employee1)
 152                (let ((lenin (car (clsql:select 'employee
 153                                                :where [= [slot-value 'employee 'emplid]
 154                                                          1]
 155                                                :flatp t))))
 156                  (concatenate 'string
 157                               (first-name lenin)
 158                               " "
 159                               (last-name lenin)
 160                               ": "
 161                               (employee-email lenin))))
 162              (progn
 163                (setf (slot-value employee1 'first-name) "Vladamir"
 164                      (slot-value employee1 'last-name) "Lenin"
 165                      (slot-value employee1 'email) "lenin@soviet.org")
 166                (clsql:update-records-from-instance employee1)
 167                (let ((lenin (car (clsql:select 'employee
 168                                                :where [= [slot-value 'employee 'emplid]
 169                                                          1]
 170                                                :flatp t))))
 171                  (concatenate 'string
 172                               (first-name lenin)
 173                               " "
 174                               (last-name lenin)
 175                               ": "
 176                               (employee-email lenin)))))
 177           "Vladamir Lenin: lenin@soviet.org"
 178           "Dimitriy Ivanovich: ivanovich@soviet.org"
 179           "Vladamir Lenin: lenin@soviet.org")
 180
 181         ;; tests update-record-from-slot
 182         (deftest :oodml/update-records/2
 183             (values
 184              (employee-email
 185               (car (clsql:select 'employee
 186                                  :where [= [slot-value 'employee 'emplid] 1]
 187                                  :flatp t)))
 188              (progn
 189                (setf (slot-value employee1 'email) "lenin-nospam@soviet.org")
 190                (clsql:update-record-from-slot employee1 'email)
 191                (employee-email
 192                 (car (clsql:select 'employee
 193                                    :where [= [slot-value 'employee 'emplid] 1]
 194                                    :flatp t))))
 195              (progn
 196                (setf (slot-value employee1 'email) "lenin@soviet.org")
 197                (clsql:update-record-from-slot employee1 'email)
 198                (employee-email
 199                 (car (clsql:select 'employee
 200                                    :where [= [slot-value 'employee 'emplid] 1]
 201                                    :flatp t)))))
 202           "lenin@soviet.org" "lenin-nospam@soviet.org" "lenin@soviet.org")
 203
 204         ;; tests update-record-from-slots
 205         (deftest :oodml/update-records/3
 206             (values
 207              (let ((lenin (car (clsql:select 'employee
 208                                              :where [= [slot-value 'employee 'emplid]
 209                                                        1]
 210                                              :flatp t))))
 211                (concatenate 'string
 212                             (first-name lenin)
 213                             " "
 214                             (last-name lenin)
 215                             ": "
 216                             (employee-email lenin)))
 217              (progn
 218                (setf (slot-value employee1 'first-name) "Dimitriy"
 219                      (slot-value employee1 'last-name) "Ivanovich"
 220                      (slot-value employee1 'email) "ivanovich@soviet.org")
 221                (clsql:update-record-from-slots employee1 '(first-name last-name email))
 222                (let ((lenin (car (clsql:select 'employee
 223                                                :where [= [slot-value 'employee 'emplid]
 224                                                          1]
 225                                                :flatp t))))
 226                  (concatenate 'string
 227                               (first-name lenin)
 228                               " "
 229                               (last-name lenin)
 230                               ": "
 231                               (employee-email lenin))))
 232              (progn
 233                (setf (slot-value employee1 'first-name) "Vladamir"
 234                      (slot-value employee1 'last-name) "Lenin"
 235                      (slot-value employee1 'email) "lenin@soviet.org")
 236                (clsql:update-record-from-slots employee1 '(first-name last-name email))
 237                (let ((lenin (car (clsql:select 'employee
 238                                                :where [= [slot-value 'employee 'emplid]
 239                                                          1]
 240                                                :flatp t))))
 241                  (concatenate 'string
 242                               (first-name lenin)
 243                               " "
 244                               (last-name lenin)
 245                               ": "
 246                               (employee-email lenin)))))
 247           "Vladamir Lenin: lenin@soviet.org"
 248           "Dimitriy Ivanovich: ivanovich@soviet.org"
 249           "Vladamir Lenin: lenin@soviet.org")
 250
 251         ;; tests update-instance-from-records
 252         (deftest :oodml/update-instance/1
 253             (values
 254              (concatenate 'string
 255                           (slot-value employee1 'first-name)
 256                           " "
 257                           (slot-value employee1 'last-name)
 258                           ": "
 259                           (slot-value employee1 'email))
 260              (progn
 261                (clsql:update-records [employee]
 262                                      :av-pairs '(([first-name] "Ivan")
 263                                                  ([last-name] "Petrov")
 264                                                  ([email] "petrov@soviet.org"))
 265                                      :where [= [emplid] 1])
 266                (clsql:update-instance-from-records employee1)
 267                (concatenate 'string
 268                             (slot-value employee1 'first-name)
 269                             " "
 270                             (slot-value employee1 'last-name)
 271                             ": "
 272                             (slot-value employee1 'email)))
 273              (progn
 274                (clsql:update-records [employee]
 275                                      :av-pairs '(([first-name] "Vladamir")
 276                                                  ([last-name] "Lenin")
 277                                                  ([email] "lenin@soviet.org"))
 278                                      :where [= [emplid] 1])
 279                (clsql:update-instance-from-records employee1)
 280                (concatenate 'string
 281                             (slot-value employee1 'first-name)
 282                             " "
 283                             (slot-value employee1 'last-name)
 284                             ": "
 285                             (slot-value employee1 'email))))
 286           "Vladamir Lenin: lenin@soviet.org"
 287           "Ivan Petrov: petrov@soviet.org"
 288           "Vladamir Lenin: lenin@soviet.org")
 289
 290         ;; tests update-slot-from-record
 291         (deftest :oodml/update-instance/2
 292             (values
 293              (slot-value employee1 'email)
 294              (progn
 295                (clsql:update-records [employee]
 296                                      :av-pairs '(([email] "lenin-nospam@soviet.org"))
 297                                      :where [= [emplid] 1])
 298                (clsql:update-slot-from-record employee1 'email)
 299                (slot-value employee1 'email))
 300              (progn
 301                (clsql:update-records [employee]
 302                                      :av-pairs '(([email] "lenin@soviet.org"))
 303                                      :where [= [emplid] 1])
 304                (clsql:update-slot-from-record employee1 'email)
 305                (slot-value employee1 'email)))
 306           "lenin@soviet.org" "lenin-nospam@soviet.org" "lenin@soviet.org")
 307
 308
 309         (deftest :oodml/do-query/1
 310             (let ((result '()))
 311               (clsql:do-query ((e) [select 'employee :order-by [emplid]])
 312                 (push (slot-value e 'last-name) result))
 313               result)
 314           ("Putin" "Yeltsin" "Gorbachev" "Chernenko" "Andropov" "Brezhnev" "Kruschev"
 315            "Trotsky" "Stalin" "Lenin"))
 316
 317         (deftest :oodml/do-query/2
 318             (let ((result '()))
 319               (clsql:do-query ((e c) [select 'employee 'company
 320                                              :where [= [slot-value 'employee 'last-name]
 321                                                        "Lenin"]])
 322                 (push (list (slot-value e 'last-name) (slot-value c 'name))
 323                       result))
 324               result)
 325           (("Lenin" "Widgets Inc.")))
 326
 327         (deftest :oodml/map-query/1
 328             (clsql:map-query 'list #'last-name [select 'employee :order-by [emplid]])
 329           ("Lenin" "Stalin" "Trotsky" "Kruschev" "Brezhnev" "Andropov" "Chernenko"
 330            "Gorbachev" "Yeltsin" "Putin"))
 331
 332         (deftest :oodml/map-query/2
 333             (clsql:map-query 'list #'(lambda (e c) (list (slot-value e 'last-name)
 334                                                          (slot-value c 'name)))
 335              [select 'employee 'company :where [= [slot-value 'employee 'last-name]
 336                                                   "Lenin"]])
 337           (("Lenin" "Widgets Inc.")))
 338
 339         (deftest :oodml/iteration/3
 340             (loop for (e) being the records in
 341              [select 'employee :where [< [emplid] 4] :order-by [emplid]]
 342              collect (slot-value e 'last-name))
 343           ("Lenin" "Stalin" "Trotsky"))
 344
 345         ))
 346
 347 #.(clsql:restore-sql-reader-syntax-state)