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