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
8 ;;;; Tests for the CLSQL Object Oriented Data Definition Language
11 ;;;; This file is part of CLSQL.
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 ;;;; ======================================================================
18 (in-package #:clsql-tests)
20 #.(clsql:locally-enable-sql-reader-syntax)
25 (deftest :oodml/select/1
26 (mapcar #'(lambda (e) (slot-value e 'last-name))
27 (clsql:select 'employee :order-by [last-name] :flatp t :caching nil))
28 ("Andropov" "Brezhnev" "Chernenko" "Gorbachev" "Kruschev" "Lenin" "Putin"
29 "Stalin" "Trotsky" "Yeltsin"))
31 (deftest :oodml/select/2
32 (mapcar #'(lambda (e) (slot-value e 'name))
33 (clsql:select 'company :flatp t :caching nil))
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]
45 (1 1 1 1 1 1 1 1 1 1))
47 (deftest :oodml/select/4
49 (concatenate 'string (slot-value e 'first-name)
51 (slot-value e 'last-name)))
52 (clsql:select 'employee :where [= [slot-value 'employee 'first-name]
57 ("Vladamir Lenin" "Vladamir Putin"))
59 (deftest :oodml/select/5
60 (length (clsql:select 'employee :where [married] :flatp t :caching nil))
63 (deftest :oodml/select/6
64 (let ((a (caar (clsql:select 'address :where [= 1 [addressid]] :caching nil))))
66 (slot-value a 'street-number)
67 (slot-value a 'street-name)
69 (slot-value a 'postal-code)))
70 10 "Park Place" "Leningrad" 123)
72 (deftest :oodml/select/7
73 (let ((a (caar (clsql:select 'address :where [= 2 [addressid]] :caching nil))))
75 (slot-value a 'street-number)
76 (slot-value a 'street-name)
78 (slot-value a 'postal-code)))
81 (deftest :oodml/select/8
82 (mapcar #'(lambda (e) (slot-value e 'married))
83 (clsql:select 'employee :flatp t :order-by [emplid] :caching nil))
84 (t t t nil nil nil nil nil nil nil))
86 (deftest :oodml/select/9
87 (mapcar #'(lambda (pair)
89 (typep (car pair) 'address)
90 (typep (second pair) 'employee-address)
91 (slot-value (car pair) 'addressid)
92 (slot-value (second pair) 'aaddressid)
93 (slot-value (second pair) 'aemplid)))
94 (employee-addresses employee1))
95 ((t t 1 1 1) (t t 2 2 1)))
97 (deftest :oodml/select/10
98 (mapcar #'(lambda (pair)
100 (typep (car pair) 'address)
101 (typep (second pair) 'employee-address)
102 (slot-value (car pair) 'addressid)
103 (slot-value (second pair) 'aaddressid)
104 (slot-value (second pair) 'aemplid)))
105 (employee-addresses employee2))
108 ;; test retrieval is deferred
109 (deftest :oodm/retrieval/1
110 (every #'(lambda (e) (not (slot-boundp e 'company)))
111 (select 'employee :flatp t :caching nil))
114 (deftest :oodm/retrieval/2
115 (every #'(lambda (e) (not (slot-boundp e 'address)))
116 (select 'deferred-employee-address :flatp t :caching nil))
119 ;; :retrieval :immediate should be boundp before accessed
120 (deftest :oodm/retrieval/3
121 (every #'(lambda (ea) (slot-boundp ea 'address))
122 (select 'employee-address :flatp t :caching nil))
125 (deftest :oodm/retrieval/4
126 (mapcar #'(lambda (ea) (typep (slot-value ea 'address) 'address))
127 (select 'employee-address :flatp t :caching nil))
130 (deftest :oodm/retrieval/5
131 (mapcar #'(lambda (ea) (typep (slot-value ea 'address) 'address))
132 (select 'deferred-employee-address :flatp t :caching nil))
135 (deftest :oodm/retrieval/6
136 (every #'(lambda (ea) (slot-boundp (slot-value ea 'address) 'addressid))
137 (select 'employee-address :flatp t :caching nil))
140 (deftest :oodm/retrieval/7
141 (every #'(lambda (ea) (slot-boundp (slot-value ea 'address) 'addressid))
142 (select 'deferred-employee-address :flatp t :caching nil))
145 (deftest :oodm/retrieval/8
146 (mapcar #'(lambda (ea) (slot-value (slot-value ea 'address) 'street-number))
147 (select 'employee-address :flatp t :order-by [aaddressid] :caching nil))
150 (deftest :oodm/retrieval/9
151 (mapcar #'(lambda (ea) (slot-value (slot-value ea 'address) 'street-number))
152 (select 'deferred-employee-address :flatp t :order-by [aaddressid] :caching nil))
155 ;; tests update-records-from-instance
156 (deftest :oodml/update-records/1
159 (let ((lenin (car (clsql:select 'employee
160 :where [= [slot-value 'employee 'emplid]
169 (employee-email lenin))))
171 (setf (slot-value employee1 'first-name) "Dimitriy"
172 (slot-value employee1 'last-name) "Ivanovich"
173 (slot-value employee1 'email) "ivanovich@soviet.org")
174 (clsql:update-records-from-instance employee1)
175 (let ((lenin (car (clsql:select 'employee
176 :where [= [slot-value 'employee 'emplid]
185 (employee-email lenin))))
187 (setf (slot-value employee1 'first-name) "Vladamir"
188 (slot-value employee1 'last-name) "Lenin"
189 (slot-value employee1 'email) "lenin@soviet.org")
190 (clsql:update-records-from-instance employee1)
191 (let ((lenin (car (clsql:select 'employee
192 :where [= [slot-value 'employee 'emplid]
201 (employee-email lenin)))))
202 "Vladamir Lenin: lenin@soviet.org"
203 "Dimitriy Ivanovich: ivanovich@soviet.org"
204 "Vladamir Lenin: lenin@soviet.org")
206 ;; tests update-record-from-slot
207 (deftest :oodml/update-records/2
210 (car (clsql:select 'employee
211 :where [= [slot-value 'employee 'emplid] 1]
215 (setf (slot-value employee1 'email) "lenin-nospam@soviet.org")
216 (clsql:update-record-from-slot employee1 'email)
218 (car (clsql:select 'employee
219 :where [= [slot-value 'employee 'emplid] 1]
223 (setf (slot-value employee1 'email) "lenin@soviet.org")
224 (clsql:update-record-from-slot employee1 'email)
226 (car (clsql:select 'employee
227 :where [= [slot-value 'employee 'emplid] 1]
230 "lenin@soviet.org" "lenin-nospam@soviet.org" "lenin@soviet.org")
232 ;; tests update-record-from-slots
233 (deftest :oodml/update-records/3
235 (let ((lenin (car (clsql:select 'employee
236 :where [= [slot-value 'employee 'emplid]
245 (employee-email lenin)))
247 (setf (slot-value employee1 'first-name) "Dimitriy"
248 (slot-value employee1 'last-name) "Ivanovich"
249 (slot-value employee1 'email) "ivanovich@soviet.org")
250 (clsql:update-record-from-slots employee1 '(first-name last-name email))
251 (let ((lenin (car (clsql:select 'employee
252 :where [= [slot-value 'employee 'emplid]
261 (employee-email lenin))))
263 (setf (slot-value employee1 'first-name) "Vladamir"
264 (slot-value employee1 'last-name) "Lenin"
265 (slot-value employee1 'email) "lenin@soviet.org")
266 (clsql:update-record-from-slots employee1 '(first-name last-name email))
267 (let ((lenin (car (clsql:select 'employee
268 :where [= [slot-value 'employee 'emplid]
277 (employee-email lenin)))))
278 "Vladamir Lenin: lenin@soviet.org"
279 "Dimitriy Ivanovich: ivanovich@soviet.org"
280 "Vladamir Lenin: lenin@soviet.org")
282 ;; tests update-instance-from-records
283 (deftest :oodml/update-instance/1
286 (slot-value employee1 'first-name)
288 (slot-value employee1 'last-name)
290 (slot-value employee1 'email))
292 (clsql:update-records [employee]
293 :av-pairs '(([first-name] "Ivan")
294 ([last-name] "Petrov")
295 ([email] "petrov@soviet.org"))
296 :where [= [emplid] 1])
297 (clsql:update-instance-from-records employee1)
299 (slot-value employee1 'first-name)
301 (slot-value employee1 'last-name)
303 (slot-value employee1 'email)))
305 (clsql:update-records [employee]
306 :av-pairs '(([first-name] "Vladamir")
307 ([last-name] "Lenin")
308 ([email] "lenin@soviet.org"))
309 :where [= [emplid] 1])
310 (clsql:update-instance-from-records employee1)
312 (slot-value employee1 'first-name)
314 (slot-value employee1 'last-name)
316 (slot-value employee1 'email))))
317 "Vladamir Lenin: lenin@soviet.org"
318 "Ivan Petrov: petrov@soviet.org"
319 "Vladamir Lenin: lenin@soviet.org")
321 ;; tests update-slot-from-record
322 (deftest :oodml/update-instance/2
324 (slot-value employee1 'email)
326 (clsql:update-records [employee]
327 :av-pairs '(([email] "lenin-nospam@soviet.org"))
328 :where [= [emplid] 1])
329 (clsql:update-slot-from-record employee1 'email)
330 (slot-value employee1 'email))
332 (clsql:update-records [employee]
333 :av-pairs '(([email] "lenin@soviet.org"))
334 :where [= [emplid] 1])
335 (clsql:update-slot-from-record employee1 'email)
336 (slot-value employee1 'email)))
337 "lenin@soviet.org" "lenin-nospam@soviet.org" "lenin@soviet.org")
340 (deftest :oodml/do-query/1
342 (clsql:do-query ((e) [select 'employee :order-by [emplid]])
343 (push (slot-value e 'last-name) result))
345 ("Putin" "Yeltsin" "Gorbachev" "Chernenko" "Andropov" "Brezhnev" "Kruschev"
346 "Trotsky" "Stalin" "Lenin"))
348 (deftest :oodml/do-query/2
350 (clsql:do-query ((e c) [select 'employee 'company
351 :where [= [slot-value 'employee 'last-name]
353 (push (list (slot-value e 'last-name) (slot-value c 'name))
356 (("Lenin" "Widgets Inc.")))
358 (deftest :oodml/map-query/1
359 (clsql:map-query 'list #'last-name [select 'employee :order-by [emplid]])
360 ("Lenin" "Stalin" "Trotsky" "Kruschev" "Brezhnev" "Andropov" "Chernenko"
361 "Gorbachev" "Yeltsin" "Putin"))
363 (deftest :oodml/map-query/2
364 (clsql:map-query 'list #'(lambda (e c) (list (slot-value e 'last-name)
365 (slot-value c 'name)))
366 [select 'employee 'company :where [= [slot-value 'employee 'last-name]
368 (("Lenin" "Widgets Inc.")))
370 (deftest :oodml/iteration/3
371 (loop for (e) being the records in
372 [select 'employee :where [< [emplid] 4] :order-by [emplid]]
373 collect (slot-value e 'last-name))
374 ("Lenin" "Stalin" "Trotsky"))
377 (deftest oodml/cache/1
379 (setf (clsql-sys:record-caches *default-database*) nil)
380 (let ((employees (select 'employee)))
381 (every #'(lambda (a b) (eq a b))
382 employees (select 'employee))))
385 (deftest oodml/cache/2
386 (let ((employees (select 'employee)))
387 (equal employees (select 'employee :flatp t)))
390 (deftest oodml/refresh/1
391 (let ((addresses (select 'address)))
392 (equal addresses (select 'address :refresh t)))
395 (deftest oodml/refresh/2
396 (let* ((addresses (select 'address :order-by [addressid] :flatp t))
397 (city (slot-value (car addresses) 'city)))
398 (clsql:update-records [addr]
399 :av-pairs '((city_field "A new city"))
400 :where [= [addressid] (slot-value (car addresses) 'addressid)])
401 (let* ((new-addresses (select 'address :order-by [addressid] :refresh t :flatp t))
402 (new-city (slot-value (car addresses) 'city))
404 (clsql:update-records [addr]
405 :av-pairs `((city_field ,city))
406 :where [= [addressid] (slot-value (car addresses) 'addressid)])
407 (values (equal addresses new-addresses)
410 t "Leningrad" "A new city")
412 (deftest oodml/refresh/3
413 (let* ((addresses (select 'address :order-by [addressid] :flatp t)))
415 (equal addresses (select 'address :refresh t :flatp t))
416 (equal addresses (select 'address :flatp t))))
419 (deftest oodml/refresh/4
420 (let* ((addresses (select 'address :order-by [addressid] :flatp t))
422 (make-instance 'address :addressid 1000 :city "A new address city")
423 (let ((new-addresses (select 'address :order-by [addressid] :flatp t :refresh t)))
424 (delete-records :from [addr] :where [= [addressid] 1000])
427 (length new-addresses)
428 (eq (first addresses) (first new-addresses))
429 (eq (second addresses) (second new-addresses)))))
435 (let* ((dea-list (select 'deferred-employee-address :caching nil :order-by [ea_join aaddressid]
437 (dea-list-copy (copy-seq dea-list))
438 (initially-unbound (every #'(lambda (dea) (not (slot-boundp dea 'address))) dea-list)))
439 (update-object-joins dea-list)
442 (equal dea-list dea-list-copy)
443 (every #'(lambda (dea) (slot-boundp dea 'address)) dea-list)
444 (every #'(lambda (dea) (typep (slot-value dea 'address) 'address)) dea-list)
445 (mapcar #'(lambda (dea) (slot-value (slot-value dea 'address) 'addressid)) dea-list))))
448 #.(clsql:restore-sql-reader-syntax-state)