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     (slot-value (caar (clsql:select 'employee :where [= 1 [emplid]])) 'married)
  63   t)
  64
  65 (deftest :oodml/select/7
  66     (slot-value (caar (clsql:select 'employee :where [= 4 [emplid]])) 'married)
  67   nil)
  68
  69 (deftest :oodml/select/8
  70     (let ((a (caar (clsql:select 'address :where [= 1 [emplid]]))))
  71       (values
  72        (slot-value a 'street-number)
  73        (slot-value a 'street-name)
  74        (slot-value a 'city)
  75        (slot-value a 'postal-code)))
  76   10 "Park Place" "Leningrad" 123)
  77
  78 (deftest :oodml/select/9
  79     (let ((a (caar (clsql:select 'address :where [= 2 [emplid]]))))
  80       (values
  81        (slot-value a 'street-number)
  82        (slot-value a 'street-name)
  83        (slot-value a 'city)
  84        (slot-value a 'postal-code)))
  85   nil "" "no city" 0)
  86
  87 (deftest :oodml/select/10
  88     (mapcar #'(lambda (e) (slot-value e 'married))
  89               (clsql:select 'employee :flatp t :order-by [emplid]))
  90   (T T T NIL NIL NIL NIL NIL NIL NIL))
  91
  92 ;; tests update-records-from-instance
  93 (deftest :oodml/update-records/1
  94     (values
  95      (progn
  96        (let ((lenin (car (clsql:select 'employee
  97                                       :where [= [slot-value 'employee 'emplid]
  98                                                 1]
  99                                       :flatp t))))
 100          (concatenate 'string
 101                       (first-name lenin)
 102                       " "
 103                       (last-name lenin)
 104                       ": "
 105                       (employee-email lenin))))
 106        (progn
 107          (setf (slot-value employee1 'first-name) "Dimitriy"
 108                (slot-value employee1 'last-name) "Ivanovich"
 109                (slot-value employee1 'email) "ivanovich@soviet.org")
 110          (clsql:update-records-from-instance employee1)
 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) "Vladamir"
 123                (slot-value employee1 'last-name) "Lenin"
 124                (slot-value employee1 'email) "lenin@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   "Vladamir Lenin: lenin@soviet.org"
 137   "Dimitriy Ivanovich: ivanovich@soviet.org"
 138   "Vladamir Lenin: lenin@soviet.org")
 139
 140 ;; tests update-record-from-slot
 141 (deftest :oodml/update-records/2
 142     (values
 143      (employee-email
 144       (car (clsql:select 'employee
 145                         :where [= [slot-value 'employee 'emplid] 1]
 146                         :flatp t)))
 147      (progn
 148        (setf (slot-value employee1 'email) "lenin-nospam@soviet.org")
 149        (clsql:update-record-from-slot employee1 'email)
 150        (employee-email
 151         (car (clsql:select 'employee
 152                           :where [= [slot-value 'employee 'emplid] 1]
 153                           :flatp t))))
 154      (progn
 155        (setf (slot-value employee1 'email) "lenin@soviet.org")
 156        (clsql:update-record-from-slot employee1 'email)
 157        (employee-email
 158         (car (clsql:select 'employee
 159                           :where [= [slot-value 'employee 'emplid] 1]
 160                           :flatp t)))))
 161   "lenin@soviet.org" "lenin-nospam@soviet.org" "lenin@soviet.org")
 162
 163 ;; tests update-record-from-slots
 164 (deftest :oodml/update-records/3
 165     (values
 166      (let ((lenin (car (clsql:select 'employee
 167                                     :where [= [slot-value 'employee 'emplid]
 168                                               1]
 169                                     :flatp t))))
 170        (concatenate 'string
 171                     (first-name lenin)
 172                     " "
 173                     (last-name lenin)
 174                     ": "
 175                     (employee-email lenin)))
 176      (progn
 177        (setf (slot-value employee1 'first-name) "Dimitriy"
 178              (slot-value employee1 'last-name) "Ivanovich"
 179              (slot-value employee1 'email) "ivanovich@soviet.org")
 180        (clsql:update-record-from-slots employee1 '(first-name last-name email))
 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) "Vladamir"
 193              (slot-value employee1 'last-name) "Lenin"
 194              (slot-value employee1 'email) "lenin@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   "Vladamir Lenin: lenin@soviet.org"
 207   "Dimitriy Ivanovich: ivanovich@soviet.org"
 208   "Vladamir Lenin: lenin@soviet.org")
 209
 210 ;; tests update-instance-from-records
 211 (deftest :oodml/update-instance/1
 212     (values
 213      (concatenate 'string
 214                   (slot-value employee1 'first-name)
 215                   " "
 216                   (slot-value employee1 'last-name)
 217                   ": "
 218                   (slot-value employee1 'email))
 219      (progn
 220        (clsql:update-records [employee]
 221                             :av-pairs '(([first-name] "Ivan")
 222                                         ([last-name] "Petrov")
 223                                         ([email] "petrov@soviet.org"))
 224                             :where [= [emplid] 1])
 225        (clsql:update-instance-from-records employee1)
 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] "Vladamir")
 235                                         ([last-name] "Lenin")
 236                                         ([email] "lenin@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   "Vladamir Lenin: lenin@soviet.org"
 246   "Ivan Petrov: petrov@soviet.org"
 247   "Vladamir Lenin: lenin@soviet.org")
 248
 249 ;; tests update-slot-from-record
 250 (deftest :oodml/update-instance/2
 251     (values
 252      (slot-value employee1 'email)
 253      (progn
 254        (clsql:update-records [employee]
 255                             :av-pairs '(([email] "lenin-nospam@soviet.org"))
 256                             :where [= [emplid] 1])
 257        (clsql:update-slot-from-record employee1 'email)
 258        (slot-value employee1 'email))
 259      (progn
 260        (clsql:update-records [employee]
 261                             :av-pairs '(([email] "lenin@soviet.org"))
 262                             :where [= [emplid] 1])
 263        (clsql:update-slot-from-record employee1 'email)
 264        (slot-value employee1 'email)))
 265   "lenin@soviet.org" "lenin-nospam@soviet.org" "lenin@soviet.org")
 266
 267
 268 (deftest :oodml/do-query/1
 269      (let ((result '()))
 270        (clsql:do-query ((e) [select 'employee :order-by [emplid]])
 271          (push (slot-value e 'last-name) result))
 272        result)
 273    ("Putin" "Yeltsin" "Gorbachev" "Chernenko" "Andropov" "Brezhnev" "Kruschev"
 274  "Trotsky" "Stalin" "Lenin"))
 275
 276 (deftest :oodml/do-query/2
 277      (let ((result '()))
 278        (clsql:do-query ((e c) [select 'employee 'company
 279                                   :where [= [slot-value 'employee 'last-name]
 280                                   "Lenin"]])
 281          (push (list (slot-value e 'last-name) (slot-value c 'name))
 282                result))
 283        result)
 284  (("Lenin" "Widgets Inc.")))
 285
 286 (deftest :oodml/map-query/1
 287      (clsql:map-query 'list #'last-name [select 'employee :order-by [emplid]])
 288  ("Lenin" "Stalin" "Trotsky" "Kruschev" "Brezhnev" "Andropov" "Chernenko"
 289   "Gorbachev" "Yeltsin" "Putin"))
 290
 291 (deftest :oodml/map-query/2
 292      (clsql:map-query 'list #'(lambda (e c) (list (slot-value e 'last-name)
 293                                                   (slot-value c 'name)))
 294       [select 'employee 'company :where [= [slot-value 'employee 'last-name]
 295                                            "Lenin"]])
 296  (("Lenin" "Widgets Inc.")))
 297
 298 ;(deftest :oodml/iteration/3
 299 ;    (loop for (e) being the tuples in
 300 ;          [select 'employee :where [married] :order-by [emplid]]
 301 ;          collect (slot-value e 'last-name))
 302 ;  ("Lenin" "Stalin" "Trotsky"))
 303
 304 ))
 305
 306 #.(clsql:restore-sql-reader-syntax-state)