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