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