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 ;; :retrieval :immediate should be boundp before accessed
115 (deftest :oodm/retrieval/2
116 (every #'(lambda (ea) (slot-boundp ea 'address))
117 (select 'employee-address :flatp t :caching nil))
120 (deftest :oodm/retrieval/3
121 (mapcar #'(lambda (ea) (typep (slot-value ea 'address) 'address))
122 (select 'employee-address :flatp t :caching nil))
125 (deftest :oodm/retrieval/4
126 (every #'(lambda (ea) (slot-boundp (slot-value ea 'address) 'addressid))
127 (select 'employee-address :flatp t :caching nil))
130 (deftest :oodm/retrieval/5
131 (mapcar #'(lambda (ea) (slot-value (slot-value ea 'address) 'street-number))
132 (select 'employee-address :flatp t :order-by [aaddressid] :caching nil))
135 ;; tests update-records-from-instance
136 (deftest :oodml/update-records/1
139 (let ((lenin (car (clsql:select 'employee
140 :where [= [slot-value 'employee 'emplid]
149 (employee-email lenin))))
151 (setf (slot-value employee1 'first-name) "Dimitriy"
152 (slot-value employee1 'last-name) "Ivanovich"
153 (slot-value employee1 'email) "ivanovich@soviet.org")
154 (clsql:update-records-from-instance employee1)
155 (let ((lenin (car (clsql:select 'employee
156 :where [= [slot-value 'employee 'emplid]
165 (employee-email lenin))))
167 (setf (slot-value employee1 'first-name) "Vladamir"
168 (slot-value employee1 'last-name) "Lenin"
169 (slot-value employee1 'email) "lenin@soviet.org")
170 (clsql:update-records-from-instance employee1)
171 (let ((lenin (car (clsql:select 'employee
172 :where [= [slot-value 'employee 'emplid]
181 (employee-email lenin)))))
182 "Vladamir Lenin: lenin@soviet.org"
183 "Dimitriy Ivanovich: ivanovich@soviet.org"
184 "Vladamir Lenin: lenin@soviet.org")
186 ;; tests update-record-from-slot
187 (deftest :oodml/update-records/2
190 (car (clsql:select 'employee
191 :where [= [slot-value 'employee 'emplid] 1]
195 (setf (slot-value employee1 'email) "lenin-nospam@soviet.org")
196 (clsql:update-record-from-slot employee1 'email)
198 (car (clsql:select 'employee
199 :where [= [slot-value 'employee 'emplid] 1]
203 (setf (slot-value employee1 'email) "lenin@soviet.org")
204 (clsql:update-record-from-slot employee1 'email)
206 (car (clsql:select 'employee
207 :where [= [slot-value 'employee 'emplid] 1]
210 "lenin@soviet.org" "lenin-nospam@soviet.org" "lenin@soviet.org")
212 ;; tests update-record-from-slots
213 (deftest :oodml/update-records/3
215 (let ((lenin (car (clsql:select 'employee
216 :where [= [slot-value 'employee 'emplid]
225 (employee-email lenin)))
227 (setf (slot-value employee1 'first-name) "Dimitriy"
228 (slot-value employee1 'last-name) "Ivanovich"
229 (slot-value employee1 'email) "ivanovich@soviet.org")
230 (clsql:update-record-from-slots employee1 '(first-name last-name email))
231 (let ((lenin (car (clsql:select 'employee
232 :where [= [slot-value 'employee 'emplid]
241 (employee-email lenin))))
243 (setf (slot-value employee1 'first-name) "Vladamir"
244 (slot-value employee1 'last-name) "Lenin"
245 (slot-value employee1 'email) "lenin@soviet.org")
246 (clsql:update-record-from-slots employee1 '(first-name last-name email))
247 (let ((lenin (car (clsql:select 'employee
248 :where [= [slot-value 'employee 'emplid]
257 (employee-email lenin)))))
258 "Vladamir Lenin: lenin@soviet.org"
259 "Dimitriy Ivanovich: ivanovich@soviet.org"
260 "Vladamir Lenin: lenin@soviet.org")
262 ;; tests update-instance-from-records
263 (deftest :oodml/update-instance/1
266 (slot-value employee1 'first-name)
268 (slot-value employee1 'last-name)
270 (slot-value employee1 'email))
272 (clsql:update-records [employee]
273 :av-pairs '(([first-name] "Ivan")
274 ([last-name] "Petrov")
275 ([email] "petrov@soviet.org"))
276 :where [= [emplid] 1])
277 (clsql:update-instance-from-records employee1)
279 (slot-value employee1 'first-name)
281 (slot-value employee1 'last-name)
283 (slot-value employee1 'email)))
285 (clsql:update-records [employee]
286 :av-pairs '(([first-name] "Vladamir")
287 ([last-name] "Lenin")
288 ([email] "lenin@soviet.org"))
289 :where [= [emplid] 1])
290 (clsql:update-instance-from-records employee1)
292 (slot-value employee1 'first-name)
294 (slot-value employee1 'last-name)
296 (slot-value employee1 'email))))
297 "Vladamir Lenin: lenin@soviet.org"
298 "Ivan Petrov: petrov@soviet.org"
299 "Vladamir Lenin: lenin@soviet.org")
301 ;; tests update-slot-from-record
302 (deftest :oodml/update-instance/2
304 (slot-value employee1 'email)
306 (clsql:update-records [employee]
307 :av-pairs '(([email] "lenin-nospam@soviet.org"))
308 :where [= [emplid] 1])
309 (clsql:update-slot-from-record employee1 'email)
310 (slot-value employee1 'email))
312 (clsql:update-records [employee]
313 :av-pairs '(([email] "lenin@soviet.org"))
314 :where [= [emplid] 1])
315 (clsql:update-slot-from-record employee1 'email)
316 (slot-value employee1 'email)))
317 "lenin@soviet.org" "lenin-nospam@soviet.org" "lenin@soviet.org")
320 (deftest :oodml/do-query/1
322 (clsql:do-query ((e) [select 'employee :order-by [emplid]])
323 (push (slot-value e 'last-name) result))
325 ("Putin" "Yeltsin" "Gorbachev" "Chernenko" "Andropov" "Brezhnev" "Kruschev"
326 "Trotsky" "Stalin" "Lenin"))
328 (deftest :oodml/do-query/2
330 (clsql:do-query ((e c) [select 'employee 'company
331 :where [= [slot-value 'employee 'last-name]
333 (push (list (slot-value e 'last-name) (slot-value c 'name))
336 (("Lenin" "Widgets Inc.")))
338 (deftest :oodml/map-query/1
339 (clsql:map-query 'list #'last-name [select 'employee :order-by [emplid]])
340 ("Lenin" "Stalin" "Trotsky" "Kruschev" "Brezhnev" "Andropov" "Chernenko"
341 "Gorbachev" "Yeltsin" "Putin"))
343 (deftest :oodml/map-query/2
344 (clsql:map-query 'list #'(lambda (e c) (list (slot-value e 'last-name)
345 (slot-value c 'name)))
346 [select 'employee 'company :where [= [slot-value 'employee 'last-name]
348 (("Lenin" "Widgets Inc.")))
350 (deftest :oodml/iteration/3
351 (loop for (e) being the records in
352 [select 'employee :where [< [emplid] 4] :order-by [emplid]]
353 collect (slot-value e 'last-name))
354 ("Lenin" "Stalin" "Trotsky"))
358 #.(clsql:restore-sql-reader-syntax-state)