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 ;; sqlite fails this because it is typeless
  58 (deftest :oodml/select/5
  59     (length (clsql:select 'employee :where [married] :flatp t))
  60   3)
  61
  62 ;; tests update-records-from-instance
  63 (deftest :oodml/update-records/1
  64     (values
  65      (progn
  66        (let ((lenin (car (clsql:select 'employee
  67                                       :where [= [slot-value 'employee 'emplid]
  68                                                 1]
  69                                       :flatp t))))
  70          (concatenate 'string
  71                       (first-name lenin)
  72                       " "
  73                       (last-name lenin)
  74                       ": "
  75                       (employee-email lenin))))
  76        (progn
  77          (setf (slot-value employee1 'first-name) "Dimitriy"
  78                (slot-value employee1 'last-name) "Ivanovich"
  79                (slot-value employee1 'email) "ivanovich@soviet.org")
  80          (clsql:update-records-from-instance employee1)
  81          (let ((lenin (car (clsql:select 'employee
  82                                       :where [= [slot-value 'employee 'emplid]
  83                                                 1]
  84                                       :flatp t))))
  85            (concatenate 'string
  86                         (first-name lenin)
  87                         " "
  88                         (last-name lenin)
  89                         ": "
  90                         (employee-email lenin))))
  91        (progn
  92          (setf (slot-value employee1 'first-name) "Vladamir"
  93                (slot-value employee1 'last-name) "Lenin"
  94                (slot-value employee1 'email) "lenin@soviet.org")
  95          (clsql:update-records-from-instance employee1)
  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   "Vladamir Lenin: lenin@soviet.org"
 107   "Dimitriy Ivanovich: ivanovich@soviet.org"
 108   "Vladamir Lenin: lenin@soviet.org")
 109
 110 ;; tests update-record-from-slot
 111 (deftest :oodml/update-records/2
 112     (values
 113      (employee-email
 114       (car (clsql:select 'employee
 115                         :where [= [slot-value 'employee 'emplid] 1]
 116                         :flatp t)))
 117      (progn
 118        (setf (slot-value employee1 'email) "lenin-nospam@soviet.org")
 119        (clsql:update-record-from-slot employee1 'email)
 120        (employee-email
 121         (car (clsql:select 'employee
 122                           :where [= [slot-value 'employee 'emplid] 1]
 123                           :flatp t))))
 124      (progn
 125        (setf (slot-value employee1 'email) "lenin@soviet.org")
 126        (clsql:update-record-from-slot employee1 'email)
 127        (employee-email
 128         (car (clsql:select 'employee
 129                           :where [= [slot-value 'employee 'emplid] 1]
 130                           :flatp t)))))
 131   "lenin@soviet.org" "lenin-nospam@soviet.org" "lenin@soviet.org")
 132
 133 ;; tests update-record-from-slots
 134 (deftest :oodml/update-records/3
 135     (values
 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) "Dimitriy"
 148              (slot-value employee1 'last-name) "Ivanovich"
 149              (slot-value employee1 'email) "ivanovich@soviet.org")
 150        (clsql:update-record-from-slots employee1 '(first-name last-name email))
 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      (progn
 162        (setf (slot-value employee1 'first-name) "Vladamir"
 163              (slot-value employee1 'last-name) "Lenin"
 164              (slot-value employee1 'email) "lenin@soviet.org")
 165        (clsql:update-record-from-slots employee1 '(first-name last-name email))
 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   "Vladamir Lenin: lenin@soviet.org"
 177   "Dimitriy Ivanovich: ivanovich@soviet.org"
 178   "Vladamir Lenin: lenin@soviet.org")
 179
 180 ;; tests update-instance-from-records
 181 (deftest :oodml/update-instance/1
 182     (values
 183      (concatenate 'string
 184                   (slot-value employee1 'first-name)
 185                   " "
 186                   (slot-value employee1 'last-name)
 187                   ": "
 188                   (slot-value employee1 'email))
 189      (progn
 190        (clsql:update-records [employee]
 191                             :av-pairs '(([first-name] "Ivan")
 192                                         ([last-name] "Petrov")
 193                                         ([email] "petrov@soviet.org"))
 194                             :where [= [emplid] 1])
 195        (clsql:update-instance-from-records employee1)
 196        (concatenate 'string
 197                     (slot-value employee1 'first-name)
 198                     " "
 199                     (slot-value employee1 'last-name)
 200                     ": "
 201                     (slot-value employee1 'email)))
 202      (progn
 203        (clsql:update-records [employee]
 204                             :av-pairs '(([first-name] "Vladamir")
 205                                         ([last-name] "Lenin")
 206                                         ([email] "lenin@soviet.org"))
 207                             :where [= [emplid] 1])
 208        (clsql:update-instance-from-records employee1)
 209        (concatenate 'string
 210                     (slot-value employee1 'first-name)
 211                     " "
 212                     (slot-value employee1 'last-name)
 213                     ": "
 214                     (slot-value employee1 'email))))
 215   "Vladamir Lenin: lenin@soviet.org"
 216   "Ivan Petrov: petrov@soviet.org"
 217   "Vladamir Lenin: lenin@soviet.org")
 218
 219 ;; tests update-slot-from-record
 220 (deftest :oodml/update-instance/2
 221     (values
 222      (slot-value employee1 'email)
 223      (progn
 224        (clsql:update-records [employee]
 225                             :av-pairs '(([email] "lenin-nospam@soviet.org"))
 226                             :where [= [emplid] 1])
 227        (clsql:update-slot-from-record employee1 'email)
 228        (slot-value employee1 'email))
 229      (progn
 230        (clsql:update-records [employee]
 231                             :av-pairs '(([email] "lenin@soviet.org"))
 232                             :where [= [emplid] 1])
 233        (clsql:update-slot-from-record employee1 'email)
 234        (slot-value employee1 'email)))
 235   "lenin@soviet.org" "lenin-nospam@soviet.org" "lenin@soviet.org")
 236
 237
 238 (deftest :oodml/do-query/1
 239      (let ((result '()))
 240        (clsql:do-query ((e) [select 'employee :order-by [emplid]])
 241          (push (slot-value e 'last-name) result))
 242        result)
 243    ("Putin" "Yeltsin" "Gorbachev" "Chernenko" "Andropov" "Brezhnev" "Kruschev"
 244  "Trotsky" "Stalin" "Lenin"))
 245
 246 (deftest :oodml/do-query/2
 247      (let ((result '()))
 248        (clsql:do-query ((e c) [select 'employee 'company
 249                                   :where [= [slot-value 'employee 'last-name]
 250                                   "Lenin"]])
 251          (push (list (slot-value e 'last-name) (slot-value c 'name))
 252                result))
 253        result)
 254  (("Lenin" "Widgets Inc.")))
 255
 256 (deftest :oodml/map-query/1
 257      (clsql:map-query 'list #'last-name [select 'employee :order-by [emplid]])
 258  ("Lenin" "Stalin" "Trotsky" "Kruschev" "Brezhnev" "Andropov" "Chernenko"
 259   "Gorbachev" "Yeltsin" "Putin"))
 260
 261 (deftest :oodml/map-query/2
 262      (clsql:map-query 'list #'(lambda (e c) (list (slot-value e 'last-name)
 263                                                   (slot-value c 'name)))
 264       [select 'employee 'company :where [= [slot-value 'employee 'last-name]
 265                                            "Lenin"]])
 266  (("Lenin" "Widgets Inc.")))
 267
 268 ;(deftest :oodml/iteration/3
 269 ;    (loop for (e) being the tuples in
 270 ;          [select 'employee :where [married] :order-by [emplid]]
 271 ;          collect (slot-value e 'last-name))
 272 ;  ("Lenin" "Stalin" "Trotsky"))
 273
 274 ))
 275
 276 #.(clsql:restore-sql-reader-syntax-state)