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