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: <04/04/2004 11:51:23 marcusp>
7 ;;;; ======================================================================
9 ;;;; Description ==========================================================
10 ;;;; ======================================================================
12 ;;;; Tests for the CLSQL-USQL Object Oriented Data Definition Language
15 ;;;; ======================================================================
17 (in-package :clsql-usql-tests)
19 #.(usql:locally-enable-sql-reader-syntax)
21 (deftest :oodml/select/1
22 (mapcar #'(lambda (e) (slot-value e 'last-name))
23 (usql:select 'employee :order-by [last-name]))
24 ("Andropov" "Brezhnev" "Chernenko" "Gorbachev" "Kruschev" "Lenin" "Putin"
25 "Stalin" "Trotsky" "Yeltsin"))
27 (deftest :oodml/select/2
28 (mapcar #'(lambda (e) (slot-value e 'name))
29 (usql:select 'company))
32 (deftest :oodml/select/3
33 (mapcar #'(lambda (e) (slot-value e 'companyid))
34 (usql:select 'employee
35 :where [and [= [slot-value 'employee 'companyid]
36 [slot-value 'company 'companyid]]
37 [= [slot-value 'company 'name]
39 (1 1 1 1 1 1 1 1 1 1))
41 (deftest :oodml/select/4
43 (concatenate 'string (slot-value e 'first-name)
45 (slot-value e 'last-name)))
46 (usql:select 'employee :where [= [slot-value 'employee 'first-name]
48 :order-by [last-name]))
49 ("Vladamir Lenin" "Vladamir Putin"))
51 ;; sqlite fails this because it is typeless
52 (deftest :oodml/select/5
53 (length (sql:select 'employee :where [married]))
56 ;; tests update-records-from-instance
57 (deftest :oodml/update-records/1
60 (let ((lenin (car (usql:select 'employee
61 :where [= [slot-value 'employee 'emplid]
68 (employee-email lenin))))
70 (setf (slot-value employee1 'first-name) "Dimitriy"
71 (slot-value employee1 'last-name) "Ivanovich"
72 (slot-value employee1 'email) "ivanovich@soviet.org")
73 (usql:update-records-from-instance employee1)
74 (let ((lenin (car (usql:select 'employee
75 :where [= [slot-value 'employee 'emplid]
82 (employee-email lenin))))
84 (setf (slot-value employee1 'first-name) "Vladamir"
85 (slot-value employee1 'last-name) "Lenin"
86 (slot-value employee1 'email) "lenin@soviet.org")
87 (usql:update-records-from-instance employee1)
88 (let ((lenin (car (usql:select 'employee
89 :where [= [slot-value 'employee 'emplid]
96 (employee-email lenin)))))
97 "Vladamir Lenin: lenin@soviet.org"
98 "Dimitriy Ivanovich: ivanovich@soviet.org"
99 "Vladamir Lenin: lenin@soviet.org")
101 ;; tests update-record-from-slot
102 (deftest :oodml/update-records/2
105 (car (usql:select 'employee
106 :where [= [slot-value 'employee 'emplid] 1])))
108 (setf (slot-value employee1 'email) "lenin-nospam@soviet.org")
109 (usql:update-record-from-slot employee1 'email)
111 (car (usql:select 'employee
112 :where [= [slot-value 'employee 'emplid] 1]))))
114 (setf (slot-value employee1 'email) "lenin@soviet.org")
115 (usql:update-record-from-slot employee1 'email)
117 (car (usql:select 'employee
118 :where [= [slot-value 'employee 'emplid] 1])))))
119 "lenin@soviet.org" "lenin-nospam@soviet.org" "lenin@soviet.org")
121 ;; tests update-record-from-slots
122 (deftest :oodml/update-records/3
124 (let ((lenin (car (usql:select 'employee
125 :where [= [slot-value 'employee 'emplid]
132 (employee-email lenin)))
134 (setf (slot-value employee1 'first-name) "Dimitriy"
135 (slot-value employee1 'last-name) "Ivanovich"
136 (slot-value employee1 'email) "ivanovich@soviet.org")
137 (usql:update-record-from-slots employee1 '(first-name last-name email))
138 (let ((lenin (car (usql:select 'employee
139 :where [= [slot-value 'employee 'emplid]
146 (employee-email lenin))))
148 (setf (slot-value employee1 'first-name) "Vladamir"
149 (slot-value employee1 'last-name) "Lenin"
150 (slot-value employee1 'email) "lenin@soviet.org")
151 (usql:update-record-from-slots employee1 '(first-name last-name email))
152 (let ((lenin (car (usql:select 'employee
153 :where [= [slot-value 'employee 'emplid]
160 (employee-email lenin)))))
161 "Vladamir Lenin: lenin@soviet.org"
162 "Dimitriy Ivanovich: ivanovich@soviet.org"
163 "Vladamir Lenin: lenin@soviet.org")
165 ;; tests update-instance-from-records
166 (deftest :oodml/update-instance/1
169 (slot-value employee1 'first-name)
171 (slot-value employee1 'last-name)
173 (slot-value employee1 'email))
175 (usql:update-records [employee]
176 :av-pairs '(([first-name] "Ivan")
177 ([last-name] "Petrov")
178 ([email] "petrov@soviet.org"))
179 :where [= [emplid] 1])
180 (usql:update-instance-from-records employee1)
182 (slot-value employee1 'first-name)
184 (slot-value employee1 'last-name)
186 (slot-value employee1 'email)))
188 (usql:update-records [employee]
189 :av-pairs '(([first-name] "Vladamir")
190 ([last-name] "Lenin")
191 ([email] "lenin@soviet.org"))
192 :where [= [emplid] 1])
193 (usql:update-instance-from-records employee1)
195 (slot-value employee1 'first-name)
197 (slot-value employee1 'last-name)
199 (slot-value employee1 'email))))
200 "Vladamir Lenin: lenin@soviet.org"
201 "Ivan Petrov: petrov@soviet.org"
202 "Vladamir Lenin: lenin@soviet.org")
204 ;; tests update-slot-from-record
205 (deftest :oodml/update-instance/2
207 (slot-value employee1 'email)
209 (usql:update-records [employee]
210 :av-pairs '(([email] "lenin-nospam@soviet.org"))
211 :where [= [emplid] 1])
212 (usql:update-slot-from-record employee1 'email)
213 (slot-value employee1 'email))
215 (usql:update-records [employee]
216 :av-pairs '(([email] "lenin@soviet.org"))
217 :where [= [emplid] 1])
218 (usql:update-slot-from-record employee1 'email)
219 (slot-value employee1 'email)))
220 "lenin@soviet.org" "lenin-nospam@soviet.org" "lenin@soviet.org")
223 ;(deftest :oodml/iteration/1
224 ; (usql:do-query ((e) [select 'usql-tests::employee :where [married]
225 ; :order-by [emplid]])
226 ; (slot-value e last-name))
227 ; ("Lenin" "Stalin" "Trotsky"))
229 ;(deftest :oodml/iteration/2
230 ; (usql:map-query 'list #'last-name [select 'employee :where [married]
231 ; :order-by [emplid]])
232 ; ("Lenin" "Stalin" "Trotsky"))
234 ;(deftest :oodml/iteration/3
235 ; (loop for (e) being the tuples in
236 ; [select 'employee :where [married] :order-by [emplid]]
237 ; collect (slot-value e 'last-name))
238 ; ("Lenin" "Stalin" "Trotsky"))
241 #.(usql:restore-sql-reader-syntax-state)