1 ;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
2 ;;;; ======================================================================
3 ;;;; File: test-oodml.lisp
4 ;;;; Created: 01/04/2004
6 ;;;; Tests for the CLSQL Object Oriented Data Definition Language
9 ;;;; This file is part of CLSQL.
11 ;;;; CLSQL users are granted the rights to distribute and use this software
12 ;;;; as governed by the terms of the Lisp Lesser GNU Public License
13 ;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL.
14 ;;;; ======================================================================
16 (in-package #:clsql-tests)
18 #.(clsql:locally-enable-sql-reader-syntax)
23 (deftest :oodml/select/1
24 (with-dataset *ds-employees*
25 (mapcar #'(lambda (e) (slot-value e 'last-name))
26 (clsql:select 'employee :order-by [last-name] :flatp t :caching nil)))
27 ("Andropov" "Brezhnev" "Chernenko" "Gorbachev" "Kruschev" "Lenin" "Putin"
28 "Stalin" "Trotsky" "Yeltsin"))
30 (deftest :oodml/select/2
31 (with-dataset *ds-employees*
32 (mapcar #'(lambda (e) (slot-value e 'name))
33 (clsql:select 'company :flatp t :caching nil)))
36 (deftest :oodml/select/3
37 (with-dataset *ds-employees*
38 (mapcar #'(lambda (e) (slot-value e 'ecompanyid))
39 (clsql:select 'employee
40 :where [and [= [slot-value 'employee 'ecompanyid]
41 [slot-value 'company 'companyid]]
42 [= [slot-value 'company 'name]
46 (1 1 1 1 1 1 1 1 1 1))
48 (deftest :oodml/select/4
49 (with-dataset *ds-employees*
51 (concatenate 'string (slot-value e 'first-name)
53 (slot-value e 'last-name)))
54 (clsql:select 'employee :where [= [slot-value 'employee 'first-name]
59 ("Vladimir Lenin" "Vladimir Putin"))
61 (deftest :oodml/select/5
62 (with-dataset *ds-employees*
63 (length (clsql:select 'employee :where [married] :flatp t :caching nil)))
66 (deftest :oodml/select/6
67 (with-dataset *ds-employees*
68 (let ((a (caar (clsql:select 'address :where [= 1 [addressid]] :caching nil))))
70 (slot-value a 'street-number)
71 (slot-value a 'street-name)
73 (slot-value a 'postal-code))))
74 10 "Park Place" "Leningrad" 123)
76 (deftest :oodml/select/7
77 (with-dataset *ds-employees*
78 (let ((a (caar (clsql:select 'address :where [= 2 [addressid]] :caching nil))))
80 (slot-value a 'street-number)
81 (slot-value a 'street-name)
83 (slot-value a 'postal-code))))
86 (deftest :oodml/select/8
87 (with-dataset *ds-employees*
88 (mapcar #'(lambda (e) (slot-value e 'married))
89 (clsql:select 'employee :flatp t :order-by [emplid] :caching nil)))
90 (t t t nil nil nil nil nil nil nil))
92 (deftest :oodml/select/9
93 (with-dataset *ds-employees*
94 (mapcar #'(lambda (pair)
96 (typep (car pair) 'address)
97 (typep (second pair) 'employee-address)
98 (slot-value (car pair) 'addressid)
99 (slot-value (second pair) 'aaddressid)
100 (slot-value (second pair) 'aemplid)))
101 (employee-addresses employee1)))
102 ((t t 1 1 1) (t t 2 2 1)))
104 (deftest :oodml/select/10
105 (with-dataset *ds-employees*
106 (mapcar #'(lambda (pair)
108 (typep (car pair) 'address)
109 (typep (second pair) 'employee-address)
110 (slot-value (car pair) 'addressid)
111 (slot-value (second pair) 'aaddressid)
112 (slot-value (second pair) 'aemplid)))
113 (employee-addresses employee2)))
116 (deftest :oodml/select/11
117 (with-dataset *ds-employees*
118 (values (mapcar #'(lambda (x) (slot-value x 'emplid))
119 (clsql:select 'employee :order-by '(([emplid] :asc))
121 (mapcar #'(lambda (x) (slot-value x 'emplid))
122 (clsql:select 'employee :order-by '(([emplid] :desc))
124 (1 2 3 4 5 6 7 8 9 10)
125 (10 9 8 7 6 5 4 3 2 1))
127 ;; test retrieval of node, derived nodes etc
128 (deftest :oodml/select/12
129 (with-dataset *ds-nodes*
130 (length (clsql:select 'node :where [node-id] :flatp t :caching nil)))
133 (deftest :oodml/select/13
134 (with-dataset *ds-nodes*
135 (let ((a (car (clsql:select 'node :where [= 1 [node-id]] :flatp t :caching nil))))
137 (slot-value a 'node-id)
138 (slot-value a 'title))))
141 (deftest :oodml/select/14
142 (with-dataset *ds-nodes*
143 (length (clsql:select 'setting :where [setting-id] :flatp t :caching nil)))
146 (deftest :oodml/select/15
147 (with-dataset *ds-nodes*
148 (let ((a (car (clsql:select 'setting :where [= 3 [setting-id]] :flatp t :caching nil))))
150 (slot-value a 'node-id)
151 (slot-value a 'setting-id)
152 (slot-value a 'title)
153 (slot-value a 'vars))))
154 3 3 "Setting2" "var 2")
156 (deftest :oodml/select/16
157 (with-dataset *ds-nodes*
158 (length (clsql:select 'user :where [user-id] :flatp t :caching nil)))
161 (deftest :oodml/select/17
162 (with-dataset *ds-nodes*
163 (let ((a (car (clsql:select 'user :where [= 4 [user-id]] :flatp t :caching nil))))
165 (slot-value a 'node-id)
166 (slot-value a 'user-id)
167 (slot-value a 'title)
168 (slot-value a 'nick))))
169 4 4 "user-1" "first user")
171 (deftest :oodml/select/18
172 (with-dataset *ds-nodes*
173 (length (clsql:select 'theme :where [theme-id] :flatp t :caching nil)))
176 (deftest :oodml/select/19
177 (with-dataset *ds-nodes*
178 (let ((a (car (clsql:select 'theme :where [= 6 [theme-id]] :flatp t :caching nil))))
179 (slot-value a 'theme-id)))
182 (deftest :oodml/select/20
183 (with-dataset *ds-nodes*
184 (let ((a (car (clsql:select 'theme :where [= 7 [theme-id]] :flatp t :caching nil))))
186 (slot-value a 'node-id)
187 (slot-value a 'theme-id)
188 (slot-value a 'title)
195 ;; Some tests to check weird subclassed nodes (node without own table, or subclassed of same)
196 (deftest :oodml/select/21
197 (with-dataset *ds-nodes*
198 (let ((a (car (clsql:select 'location :where [= [title] "location-1"] :flatp t :caching nil))))
200 (slot-value a 'node-id)
201 (slot-value a 'title))))
204 (deftest :oodml/select/22
205 (with-dataset *ds-nodes*
206 (let ((a (car (clsql:select 'subloc :where [subloc-id] :flatp t :caching nil))))
208 (slot-value a 'node-id)
209 (slot-value a 'subloc-id)
210 (slot-value a 'title)
211 (slot-value a 'loc))))
212 10 10 "subloc-1" "a subloc")
214 (deftest :oodml/select/23
215 (with-dataset *ds-artists*
216 (length (clsql:select 'artist :flatp t :caching nil)))
219 ;; test retrieval is deferred
220 (deftest :oodm/retrieval/1
221 (with-dataset *ds-employees*
222 (every #'(lambda (e) (not (slot-boundp e 'company)))
223 (select 'employee :flatp t :caching nil)))
226 (deftest :oodm/retrieval/2
227 (with-dataset *ds-employees*
228 (every #'(lambda (e) (not (slot-boundp e 'address)))
229 (select 'deferred-employee-address :flatp t :caching nil)))
232 ;; :retrieval :immediate should be boundp before accessed
233 (deftest :oodm/retrieval/3
234 (with-dataset *ds-employees*
235 (every #'(lambda (ea) (slot-boundp ea 'address))
236 (select 'employee-address :flatp t :caching nil)))
239 (deftest :oodm/retrieval/4
240 (with-dataset *ds-employees*
241 (mapcar #'(lambda (ea) (typep (slot-value ea 'address) 'address))
242 (select 'employee-address :flatp t :caching nil)))
245 (deftest :oodm/retrieval/5
246 (with-dataset *ds-employees*
247 (mapcar #'(lambda (ea) (typep (slot-value ea 'address) 'address))
248 (select 'deferred-employee-address :flatp t :caching nil)))
251 (deftest :oodm/retrieval/6
252 (with-dataset *ds-employees*
253 (every #'(lambda (ea) (slot-boundp (slot-value ea 'address) 'addressid))
254 (select 'employee-address :flatp t :caching nil)))
257 (deftest :oodm/retrieval/7
258 (with-dataset *ds-employees*
259 (every #'(lambda (ea) (slot-boundp (slot-value ea 'address) 'addressid))
260 (select 'deferred-employee-address :flatp t :caching nil)))
263 (deftest :oodm/retrieval/8
264 (with-dataset *ds-employees*
265 (mapcar #'(lambda (ea) (slot-value (slot-value ea 'address) 'street-number))
266 (select 'employee-address :flatp t :order-by [aaddressid] :caching nil)))
269 (deftest :oodm/retrieval/9
270 (with-dataset *ds-employees*
271 (mapcar #'(lambda (ea) (slot-value (slot-value ea 'address) 'street-number))
272 (select 'deferred-employee-address :flatp t :order-by [aaddressid] :caching nil)))
275 ;; tests update-records-from-instance
276 (deftest :oodml/update-records/1
277 (with-dataset *ds-employees*
280 (let ((lenin (car (clsql:select 'employee
281 :where [= 1 [slot-value 'employee 'emplid]]
284 (format nil "~a ~a: ~a"
287 (employee-email lenin))))
289 (setf (slot-value employee1 'first-name) "Dimitriy"
290 (slot-value employee1 'last-name) "Ivanovich"
291 (slot-value employee1 'email) "ivanovich@soviet.org")
292 (clsql:update-records-from-instance employee1)
293 (let ((lenin (car (clsql:select 'employee
294 :where [= 1 [slot-value 'employee 'emplid]]
297 (format nil "~a ~a: ~a"
300 (employee-email lenin))))))
301 "Vladimir Lenin: lenin@soviet.org"
302 "Dimitriy Ivanovich: ivanovich@soviet.org")
304 ;; tests update-record-from-slot
305 (deftest :oodml/update-records/2
306 (with-dataset *ds-employees*
309 (car (clsql:select 'employee
310 :where [= 1 [slot-value 'employee 'emplid]]
314 (setf (slot-value employee1 'email) "lenin-nospam@soviet.org")
315 (clsql:update-record-from-slot employee1 'email)
317 (car (clsql:select 'employee
318 :where [= 1 [slot-value 'employee 'emplid]]
321 "lenin@soviet.org" "lenin-nospam@soviet.org")
323 ;; tests update-record-from-slots
324 (deftest :oodml/update-records/3
325 (with-dataset *ds-employees*
327 (let ((lenin (car (clsql:select 'employee
328 :where [= 1 [slot-value 'employee 'emplid]]
331 (format nil "~a ~a: ~a"
334 (employee-email lenin)))
336 (setf (slot-value employee1 'first-name) "Dimitriy"
337 (slot-value employee1 'last-name) "Ivanovich"
338 (slot-value employee1 'email) "ivanovich@soviet.org")
339 (clsql:update-record-from-slots employee1 '(first-name last-name email))
340 (let ((lenin (car (clsql:select 'employee
341 :where [= 1 [slot-value 'employee 'emplid]]
344 (format nil "~a ~a: ~a"
347 (employee-email lenin))))))
348 "Vladimir Lenin: lenin@soviet.org"
349 "Dimitriy Ivanovich: ivanovich@soviet.org")
351 (deftest :oodml/update-records/4
352 (with-dataset *ds-nodes*
353 (flet ((print-fresh-node ()
354 (let ((base (car (clsql:select 'node
355 :where [= 1 [slot-value 'node 'node-id]]
356 :flatp t :caching nil))))
358 (slot-value base 'node-id)
359 (slot-value base 'title)))))
362 (let ((base (car (clsql:select 'node
363 :where [= 1 [slot-value 'node 'node-id]]
364 :flatp t :caching nil))))
365 (setf (slot-value base 'title) "Altered title")
366 (clsql:update-records-from-instance base)
367 (print-fresh-node)))))
371 (deftest :oodml/update-records/4-slots ;just like 4, but use slots fns.
372 (with-dataset *ds-nodes*
373 (flet ((print-fresh-setting ()
374 (let ((node (car (clsql:select 'setting
375 :where [= 3 [slot-value 'setting 'setting-id]]
376 :flatp t :caching nil))))
377 (format nil "~a ~a ~a"
378 (slot-value node 'setting-id)
379 (slot-value node 'title)
380 (slot-value node 'vars)))))
382 (print-fresh-setting)
383 (let ((node (car (clsql:select 'setting
384 :where [= 3 [slot-value 'setting 'setting-id]]
385 :flatp t :caching nil))))
386 (setf (slot-value node 'title) "Altered title")
387 (setf (slot-value node 'vars) "Altered vars")
388 (clsql-sys:update-record-from-slot node 'title)
389 (clsql-sys:update-record-from-slot node 'vars)
390 (print-fresh-setting))
391 (let ((node (car (clsql:select 'setting
392 :where [= 3 [slot-value 'setting 'setting-id]]
393 :flatp t :caching nil))))
394 (setf (slot-value node 'title) "Setting2")
395 (setf (slot-value node 'vars) "var 2")
396 (clsql:update-records-from-instance node)
397 (clsql-sys:update-record-from-slots node '(vars title))
398 (print-fresh-setting)))))
400 "3 Altered title Altered vars"
403 (deftest :oodml/update-records/5
404 (with-dataset *ds-nodes*
405 (flet ((print-fresh-setting ()
406 (let ((node (car (clsql:select 'setting
407 :where [= 3 [slot-value 'setting 'setting-id]]
408 :flatp t :caching nil))))
409 (format nil "~a ~a ~a"
410 (slot-value node 'setting-id)
411 (slot-value node 'title)
412 (slot-value node 'vars)))))
414 (print-fresh-setting)
415 (let ((node (car (clsql:select 'setting
416 :where [= 3 [slot-value 'setting 'setting-id]]
417 :flatp t :caching nil))))
418 (setf (slot-value node 'title) "Altered title")
419 (setf (slot-value node 'vars) "Altered vars")
420 (clsql:update-records-from-instance node)
421 (print-fresh-setting)))))
423 "3 Altered title Altered vars")
425 (deftest :oodml/update-records/5-slots
426 (with-dataset *ds-nodes*
427 (flet ((print-fresh-setting ()
428 (let ((node (car (clsql:select 'setting
429 :where [= 3 [slot-value 'setting 'setting-id]]
430 :flatp t :caching nil))))
431 (format nil "~a ~a ~a"
432 (slot-value node 'setting-id)
433 (slot-value node 'title)
434 (slot-value node 'vars)))))
436 (print-fresh-setting)
437 (let ((node (car (clsql:select 'setting
438 :where [= 3 [slot-value 'setting 'setting-id]]
439 :flatp t :caching nil))))
440 (setf (slot-value node 'title) "Altered title")
441 (setf (slot-value node 'vars) "Altered vars")
442 (clsql-sys:update-record-from-slot node 'title)
443 (clsql-sys:update-record-from-slot node 'vars)
444 (print-fresh-setting))
445 (let ((node (car (clsql:select 'setting
446 :where [= 3 [slot-value 'setting 'setting-id]]
447 :flatp t :caching nil))))
448 (setf (slot-value node 'title) "Setting2")
449 (setf (slot-value node 'vars) "var 2")
450 (clsql-sys:update-record-from-slots node '(title vars))
451 (print-fresh-setting)))))
453 "3 Altered title Altered vars"
456 (deftest :oodml/update-records/6
457 (with-dataset *ds-nodes*
458 (flet ((print-fresh-setting ()
459 (let ((node (car (clsql:select 'setting
460 :where [= 7 [slot-value 'setting 'setting-id]]
461 :flatp t :caching nil))))
462 (format nil "~a ~a ~a"
463 (slot-value node 'setting-id)
464 (slot-value node 'title)
465 (or (slot-value node 'vars) "NIL")))))
467 (print-fresh-setting)
468 (let ((node (car (clsql:select 'setting
469 :where [= 7 [slot-value 'setting 'setting-id]]
470 :flatp t :caching nil))))
471 (setf (slot-value node 'title) "Altered title")
472 (setf (slot-value node 'vars) "Altered vars")
473 (clsql:update-records-from-instance node)
474 (print-fresh-setting))
475 (let ((node (car (clsql:select 'setting
476 :where [= 7 [slot-value 'setting 'setting-id]]
477 :flatp t :caching nil))))
478 (setf (slot-value node 'title) "theme-2")
479 (setf (slot-value node 'vars) nil)
480 (clsql:update-records-from-instance node)
481 (print-fresh-setting)))))
483 "7 Altered title Altered vars"
486 (deftest :oodml/update-records/7
487 (with-dataset *ds-nodes*
488 (flet ((print-fresh-user ()
489 "requery to get what the db has, and print out."
490 (let ((node (car (clsql:select 'user
491 :where [= 5 [slot-value 'user 'user-id]]
492 :flatp t :caching nil))))
493 (format nil "~a ~a ~a"
494 (slot-value node 'user-id)
495 (slot-value node 'title)
496 (slot-value node 'nick)))))
499 (let ((node (car (clsql:select 'user
500 :where [= 5 [slot-value 'user 'user-id]]
501 :flatp t :caching nil))))
502 (setf (slot-value node 'title) "Altered title")
503 (setf (slot-value node 'nick) "Altered nick")
504 (clsql:update-records-from-instance node)
505 (print-fresh-user)))))
506 "5 user-2 second user"
507 "5 Altered title Altered nick")
509 (deftest :oodml/update-records/8
510 (with-dataset *ds-nodes*
511 (flet ((print-fresh-theme ()
512 (let ((node (car (clsql:select 'theme
513 :where [= 6 [slot-value 'theme 'theme-id]]
514 :flatp t :caching nil))))
515 (with-slots (node-id setting-id theme-id title vars doc) node
516 (format nil "~a ~a ~a ~a ~a ~a"
517 node-id setting-id theme-id
518 title (or vars "NIL") doc)))))
521 (let ((node (car (clsql:select 'setting
522 :where [= 6 [slot-value 'setting 'setting-id]]
523 :flatp t :caching nil))))
524 (setf (slot-value node 'title) "Altered title")
525 (setf (slot-value node 'vars) nil)
526 (clsql:update-records-from-instance node)
528 (let ((node (car (clsql:select 'theme
529 :where [= 6 [slot-value 'theme 'theme-id]]
530 :flatp t :caching nil))))
531 (setf (slot-value node 'title) "Altered title again")
532 (setf (slot-value node 'doc) "altered doc")
533 (clsql:update-records-from-instance node)
535 (let ((node (car (clsql:select 'theme
536 :where [= 6 [slot-value 'theme 'theme-id]]
537 :flatp t :caching nil))))
538 (setf (slot-value node 'title) "theme-1")
539 (setf (slot-value node 'vars) "empty")
540 (setf (slot-value node 'doc) "first theme")
541 (clsql:update-records-from-instance node)
542 (print-fresh-theme)))))
543 "6 6 6 theme-1 empty first theme"
544 "6 6 6 Altered title NIL first theme"
545 "6 6 6 Altered title again NIL altered doc"
546 "6 6 6 theme-1 empty first theme")
548 (deftest :oodml/update-records/9
549 (with-dataset *ds-nodes*
550 (flet ((print-fresh-subloc ()
551 (let ((sl (car (clsql:select 'subloc
552 :where [= 10 [slot-value 'subloc 'subloc-id]]
553 :flatp t :caching nil))))
554 (format nil "~a ~a ~a"
555 (slot-value sl 'subloc-id)
556 (slot-value sl 'title)
557 (slot-value sl 'loc)))))
560 (let ((sl (car (clsql:select 'subloc
561 :where [= 10 [slot-value 'subloc 'subloc-id]]
562 :flatp t :caching nil))))
563 (setf (slot-value sl 'title) "Altered subloc title")
564 (setf (slot-value sl 'loc) "Altered loc")
565 (clsql:update-records-from-instance sl)
566 (print-fresh-subloc)))))
567 "10 subloc-1 a subloc"
568 "10 Altered subloc title Altered loc")
570 (deftest :oodml/update-records/9-slots ;like 9, but use slots fns.
571 (with-dataset *ds-nodes*
572 (flet ((print-fresh-subloc ()
573 (let ((sl (car (clsql:select 'subloc
574 :where [= 10 [slot-value 'subloc 'subloc-id]]
575 :flatp t :caching nil))))
576 (format nil "~a ~a ~a"
577 (slot-value sl 'subloc-id)
578 (slot-value sl 'title)
579 (slot-value sl 'loc)))))
582 (let ((sl (car (clsql:select 'subloc
583 :where [= 10 [slot-value 'subloc 'subloc-id]]
584 :flatp t :caching nil))))
585 (setf (slot-value sl 'title) "Altered subloc title")
586 (setf (slot-value sl 'loc) "Altered loc")
587 (clsql:update-record-from-slot sl 'title)
588 (clsql:update-record-from-slot sl 'loc)
589 (print-fresh-subloc))
590 (let ((sl (car (clsql:select 'subloc
591 :where [= 10 [slot-value 'subloc 'subloc-id]]
592 :flatp t :caching nil))))
593 (setf (slot-value sl 'title) "subloc-1")
594 (setf (slot-value sl 'loc) "a subloc")
595 (clsql:update-record-from-slots sl '(title loc))
596 (print-fresh-subloc)))))
597 "10 subloc-1 a subloc"
598 "10 Altered subloc title Altered loc"
599 "10 subloc-1 a subloc")
601 ;; Verify that we can set a float to nil and then read it back
602 ;; (was failing in Postgresql at somepoint)
603 (deftest :oodml/update-records/10
604 (with-dataset *ds-employees*
605 (let ((emp (first (clsql:select 'employee :where [= [emplid] 1] :flatp t))))
606 (setf (height emp) nil)
607 (clsql-sys:update-record-from-slot emp 'height)
609 (clsql:select [height] :from [employee] :where [= [emplid] 1])
611 (setf (height emp) 42.0)
612 (clsql-sys:update-record-from-slot emp 'height)
613 (clsql:select [height] :from [employee] :where [= [emplid] 1]))
615 (setf (height emp) 24.13d0)
616 (clsql-sys:update-record-from-slot emp 'height)
617 (clsql:select [height] :from [employee] :where [= [emplid] 1])))))
622 (deftest :oodml/update-records/11
623 (with-dataset *ds-artists*
624 (clsql:update-records-from-instance artist1)
625 (list (name artist1) (artist_id artist1)))
628 ;; tests update-instance-from-records
629 (deftest :oodml/update-instance/1
630 (with-dataset *ds-employees*
632 (format nil "~a ~a: ~a"
633 (slot-value employee1 'first-name)
634 (slot-value employee1 'last-name)
635 (slot-value employee1 'email))
637 (clsql:update-records [employee]
638 :av-pairs '(([first-name] "Ivan")
639 ([last-name] "Petrov")
640 ([email] "petrov@soviet.org"))
641 :where [= [emplid] 1])
642 (clsql:update-instance-from-records employee1)
643 (format nil "~a ~a: ~a"
644 (slot-value employee1 'first-name)
645 (slot-value employee1 'last-name)
646 (slot-value employee1 'email)))))
647 "Vladimir Lenin: lenin@soviet.org"
648 "Ivan Petrov: petrov@soviet.org")
650 ;; tests update-slot-from-record
651 (deftest :oodml/update-instance/2
652 (with-dataset *ds-employees*
654 (slot-value employee1 'email)
656 (clsql:update-records [employee]
657 :av-pairs '(([email] "lenin-nospam@soviet.org"))
658 :where [= [emplid] 1])
659 (clsql:update-slot-from-record employee1 'email)
660 (slot-value employee1 'email))))
661 "lenin@soviet.org" "lenin-nospam@soviet.org")
663 ;; tests normalizedp update-instance-from-records
664 (deftest :oodml/update-instance/3
665 (with-dataset *ds-nodes*
667 (with-output-to-string (out)
668 (format out "~a ~a ~a ~a"
669 (slot-value theme2 'theme-id)
670 (slot-value theme2 'title)
671 (or (slot-value theme2 'vars) "NIL")
672 (slot-value theme2 'doc)))
674 (clsql:update-records [node] :av-pairs '(([title] "Altered title"))
675 :where [= [node-id] 7])
676 (clsql:update-records [setting] :av-pairs '(([vars] "Altered vars"))
677 :where [= [setting-id] 7])
678 (clsql:update-records [theme] :av-pairs '(([doc] "Altered doc"))
679 :where [= [theme-id] 7])
680 (clsql:update-instance-from-records theme2)
681 (with-output-to-string (out)
682 (format out "~a ~a ~a ~a"
683 (slot-value theme2 'theme-id)
684 (slot-value theme2 'title)
685 (slot-value theme2 'vars)
686 (slot-value theme2 'doc))))))
687 "7 theme-2 NIL second theme"
688 "7 Altered title Altered vars Altered doc")
690 (deftest :oodml/update-instance/4
691 (with-dataset *ds-nodes*
694 (setf loc2 (car (clsql:select 'location
695 :where [= [node-id] 9]
696 :flatp t :caching nil)))
698 (slot-value loc2 'node-id)
699 (slot-value loc2 'title)))
701 (clsql:update-records [node] :av-pairs '(([title] "Altered title"))
702 :where [= [node-id] 9])
703 (clsql:update-instance-from-records loc2)
705 (slot-value loc2 'node-id)
706 (slot-value loc2 'title)))))
710 (deftest :oodml/update-instance/5
711 (with-dataset *ds-nodes*
713 (format nil "~a ~a ~a"
714 (slot-value subloc2 'subloc-id)
715 (slot-value subloc2 'title)
716 (slot-value subloc2 'loc))
718 (clsql:update-records [node] :av-pairs '(([title] "Altered title"))
719 :where [= [node-id] 11])
720 (clsql:update-records [subloc] :av-pairs '(([loc] "Altered loc"))
721 :where [= [subloc-id] 11])
722 (clsql:update-instance-from-records subloc2)
723 (format nil "~a ~a ~a"
724 (slot-value subloc2 'subloc-id)
725 (slot-value subloc2 'title)
726 (slot-value subloc2 'loc)))))
727 "11 subloc-2 second subloc"
728 "11 Altered title Altered loc")
730 ;; tests update-slot-from-record with normalizedp stuff
731 (deftest :oodml/update-instance/6
732 (with-dataset *ds-nodes*
734 (slot-value theme1 'doc)
735 (slot-value theme1 'vars)
737 (clsql:update-records [theme]
738 :av-pairs '(([doc] "altered doc"))
739 :where [= [theme-id] 6])
740 (clsql:update-slot-from-record theme1 'doc)
741 (slot-value theme1 'doc))
743 (clsql:update-records [setting]
744 :av-pairs '(([vars] "altered vars"))
745 :where [= [setting-id] 6])
746 (clsql:update-slot-from-record theme1 'vars)
747 (slot-value theme1 'vars))))
748 "first theme" "empty"
749 "altered doc" "altered vars")
751 (deftest :oodml/update-instance/7
752 (flet ((print-loc (l)
754 (slot-value l 'node-id) (slot-value l 'title)))
757 (slot-value sl 'node-id) (slot-value sl 'loc))))
758 (with-dataset *ds-nodes*
761 (print-subloc subloc2)
763 (clsql:update-records [node]
764 :av-pairs '(([title] "altered title"))
765 :where [= [node-id] 9])
766 (clsql:update-slot-from-record loc2 'title)
769 (clsql:update-records [subloc]
770 :av-pairs '(([loc] "altered loc"))
771 :where [= [subloc-id] 11])
772 (clsql:update-slot-from-record subloc2 'loc)
773 (print-subloc subloc2)))))
774 "9: location-2" "11: second subloc"
775 "9: altered title" "11: altered loc")
777 (deftest :oodml/do-query/1
778 (with-dataset *ds-employees*
780 (clsql:do-query ((e) [select 'employee :order-by [emplid]])
781 (push (slot-value e 'last-name) result))
783 ("Putin" "Yeltsin" "Gorbachev" "Chernenko" "Andropov" "Brezhnev" "Kruschev"
784 "Trotsky" "Stalin" "Lenin"))
786 (deftest :oodml/do-query/2
787 (with-dataset *ds-employees*
789 (clsql:do-query ((e c) [select 'employee 'company
790 :where [= [slot-value 'employee 'last-name]
792 (push (list (slot-value e 'last-name) (slot-value c 'name))
795 (("Lenin" "Widgets Inc.")))
797 (deftest :oodml/map-query/1
798 (with-dataset *ds-employees*
799 (clsql:map-query 'list #'last-name [select 'employee :order-by [emplid]]))
800 ("Lenin" "Stalin" "Trotsky" "Kruschev" "Brezhnev" "Andropov" "Chernenko"
801 "Gorbachev" "Yeltsin" "Putin"))
803 (deftest :oodml/map-query/2
804 (with-dataset *ds-employees*
805 (clsql:map-query 'list #'(lambda (e c) (list (slot-value e 'last-name)
806 (slot-value c 'name)))
807 [select 'employee 'company :where [= [slot-value 'employee 'last-name]
809 (("Lenin" "Widgets Inc.")))
811 (deftest :oodml/iteration/3
812 (with-dataset *ds-employees*
813 (loop for (e) being the records in
814 [select 'employee :where [< [emplid] 4] :order-by [emplid]]
815 collect (slot-value e 'last-name)))
816 ("Lenin" "Stalin" "Trotsky"))
819 (deftest :oodml/cache/1
820 (with-dataset *ds-employees*
822 (setf (clsql-sys:record-caches *default-database*) nil)
823 (let ((employees (select 'employee)))
824 (every #'(lambda (a b) (eq a b))
825 employees (select 'employee)))))
828 (deftest :oodml/cache/2
829 (with-dataset *ds-employees*
830 (let ((employees (select 'employee)))
831 (equal employees (select 'employee :flatp t))))
834 (deftest :oodml/refresh/1
835 (with-dataset *ds-employees*
836 (let ((addresses (select 'address)))
837 (equal addresses (select 'address :refresh t))))
840 (deftest :oodml/refresh/2
841 (with-dataset *ds-employees*
842 (let* ((addresses (select 'address :order-by [addressid] :flatp t :refresh t))
843 (city (slot-value (car addresses) 'city)))
844 (clsql:update-records [addr]
845 :av-pairs '((city_field "A new city"))
846 :where [= [addressid] (slot-value (car addresses) 'addressid)])
847 (let* ((new-addresses (select 'address :order-by [addressid] :refresh t :flatp t))
848 (new-city (slot-value (car addresses) 'city))
850 (clsql:update-records [addr]
851 :av-pairs `((city_field ,city))
852 :where [= [addressid] (slot-value (car addresses) 'addressid)])
853 (values (equal addresses new-addresses)
856 t "Leningrad" "A new city")
858 (deftest :oodml/refresh/3
859 (with-dataset *ds-employees*
860 (let* ((addresses (select 'address :order-by [addressid] :flatp t)))
862 (equal addresses (select 'address :refresh t :flatp t))
863 (equal addresses (select 'address :flatp t)))))
866 (deftest :oodml/refresh/4
867 (with-dataset *ds-employees*
868 (let* ((addresses (select 'address :order-by [addressid] :flatp t :refresh t))
870 (make-instance 'address :addressid 1000 :city "A new address city")
871 (let ((new-addresses (select 'address :order-by [addressid] :flatp t :refresh t)))
872 (delete-records :from [addr] :where [= [addressid] 1000])
875 (length new-addresses)
876 (eq (first addresses) (first new-addresses))
877 (eq (second addresses) (second new-addresses))))))
881 (deftest :oodml/uoj/1
882 (with-dataset *ds-employees*
884 (let* ((dea-list (select 'deferred-employee-address :caching nil :order-by ["ea_join" aaddressid]
886 (dea-list-copy (copy-seq dea-list))
887 (initially-unbound (every #'(lambda (dea) (not (slot-boundp dea 'address))) dea-list)))
888 (update-objects-joins dea-list)
891 (equal dea-list dea-list-copy)
892 (every #'(lambda (dea) (slot-boundp dea 'address)) dea-list)
893 (every #'(lambda (dea) (typep (slot-value dea 'address) 'address)) dea-list)
894 (mapcar #'(lambda (dea) (slot-value (slot-value dea 'address) 'addressid)) dea-list)))))
897 ;; update-object-joins needs to be fixed for multiple keys
899 (deftest :oodml/uoj/2
901 (clsql:update-objects-joins (list company1))
902 (mapcar #'(lambda (e)
903 (slot-value e 'ecompanyid))
904 (company-employees company1)))
905 (1 1 1 1 1 1 1 1 1 1))
907 (deftest :oodml/big/1
908 (with-dataset *ds-big*
909 (let ((objs (clsql:select 'big :order-by [i] :flatp t)))
914 (rest objs (cdr rest)))
915 ((= i (length objs)) t)
916 (let ((obj (car rest))
918 (unless (and (eql (slot-value obj 'i) index)
919 (eql (slot-value obj 'bi) (truncate max index)))
925 (deftest :oodml/db-auto-sync/1
926 (with-dataset *ds-employees*
929 (make-instance 'employee :emplid 20 :groupid 1
930 :last-name "Ivanovich")
931 (select [last-name] :from [employee] :where [= [emplid] 20]
932 :flatp t :field-names nil))
933 (let ((*db-auto-sync* t))
934 (make-instance 'employee :emplid 20 :groupid 1
935 :last-name "Ivanovich")
936 (prog1 (select [last-name] :from [employee] :flatp t
938 :where [= [emplid] 20])
939 (delete-records :from [employee] :where [= [emplid] 20])))))
942 (deftest :oodml/db-auto-sync/2
943 (with-dataset *ds-employees*
945 (let ((instance (make-instance 'employee :emplid 20 :groupid 1
946 :last-name "Ivanovich")))
947 (setf (slot-value instance 'last-name) "Bulgakov")
948 (select [last-name] :from [employee] :where [= [emplid] 20]
949 :flatp t :field-names nil))
950 (let* ((*db-auto-sync* t)
951 (instance (make-instance 'employee :emplid 20 :groupid 1
952 :last-name "Ivanovich")))
953 (setf (slot-value instance 'last-name) "Bulgakov")
954 (prog1 (select [last-name] :from [employee] :flatp t
956 :where [= [emplid] 20])
957 (delete-records :from [employee] :where [= [emplid] 20])))))
960 (deftest :oodml/db-auto-sync/3
961 (with-dataset *ds-nodes*
964 (make-instance 'theme :title "test-theme" :vars "test-vars"
966 (select [node-id] :from [node] :where [= [title] "test-theme"]
967 :flatp t :field-names nil))
968 (let ((*db-auto-sync* t))
969 (make-instance 'theme :title "test-theme" :vars "test-vars"
971 (prog1 (select [title] :from [node] :where [= [title] "test-theme"]
972 :flatp t :field-names nil)
973 (delete-records :from [node] :where [= [title] "test-theme"])
974 (delete-records :from [setting] :where [= [vars] "test-vars"])
975 (delete-records :from [theme] :where [= [doc] "test-doc"])))))
978 (deftest :oodml/db-auto-sync/4
979 (with-dataset *ds-nodes*
981 (let ((inst (make-instance 'theme
982 :title "test-theme" :vars "test-vars"
984 (*print-circle* nil))
985 (setf (slot-value inst 'title) "alternate-test-theme")
986 (format nil "~a ~a ~a ~a"
987 (or (select [title] :from [node]
988 :where [= [title] "test-theme"]
989 :flatp t :field-names nil) "NIL")
990 (or (select [vars] :from [setting]
991 :where [= [vars] "test-vars"]
992 :flatp t :field-names nil) "NIL")
993 (or (select [doc] :from [theme]
994 :where [= [doc] "test-doc"]
995 :flatp t :field-names nil) "NIL")
996 (or (select [title] :from [node]
997 :where [= [title] "alternate-test-theme"]
998 :flatp t :field-names nil) "NIL")))
999 (let* ((*db-auto-sync* t)
1000 (inst (make-instance 'theme
1001 :title "test-theme" :vars "test-vars"
1003 (setf (slot-value inst 'title) "alternate-test-theme")
1005 (format nil "~a ~a ~a ~a"
1006 (or (select [title] :from [node]
1007 :where [= [title] "test-theme"]
1008 :flatp t :field-names nil) "NIL")
1009 (or (select [vars] :from [setting]
1010 :where [= [vars] "test-vars"]
1011 :flatp t :field-names nil) "NIL")
1012 (or (select [doc] :from [theme]
1013 :where [= [doc] "test-doc"]
1014 :flatp t :field-names nil) "NIL")
1015 (or (select [title] :from [node]
1016 :where [= [title] "alternate-test-theme"]
1017 :flatp t :field-names nil) "NIL"))
1018 (delete-records :from [node] :where [= [title] "alternate-test-theme"])
1019 (delete-records :from [setting] :where [= [vars] "test-vars"])
1020 (delete-records :from [theme] :where [= [doc] "test-doc"])))))
1022 "NIL (test-vars) (test-doc) (alternate-test-theme)")
1024 (deftest :oodml/setf-slot-value/1
1025 (with-dataset *ds-employees*
1026 (let* ((*db-auto-sync* t)
1027 (instance (make-instance 'employee :emplid 20 :groupid 1)))
1030 (slot-value instance 'first-name) "Mikhail"
1031 (slot-value instance 'last-name) "Bulgakov")
1032 (delete-records :from [employee] :where [= [emplid] 20]))))
1035 (deftest :oodml/float/1
1036 (with-dataset *ds-employees*
1037 (let* ((emp1 (car (select 'employee
1038 :where [= [slot-value 'employee 'emplid]
1042 (height (slot-value emp1 'height)))
1045 (setf (slot-value emp1 'height) 1.0E0)
1046 (clsql:update-record-from-slot emp1 'height)
1047 (= (car (clsql:select [height] :from [employee]
1048 :where [= [emplid] 1]
1052 (setf (slot-value emp1 'height) height)
1053 (clsql:update-record-from-slot emp1 'height))))
1056 (deftest :oodml/float/2
1057 (with-dataset *ds-employees*
1058 (let* ((emp1 (car (select 'employee
1059 :where [= [slot-value 'employee 'emplid]
1063 (height (slot-value emp1 'height)))
1066 (setf (slot-value emp1 'height) 1.0S0)
1067 (clsql:update-record-from-slot emp1 'height)
1068 (= (car (clsql:select [height] :from [employee]
1069 :where [= [emplid] 1]
1073 (setf (slot-value emp1 'height) height)
1074 (clsql:update-record-from-slot emp1 'height))))
1077 (deftest :oodml/float/3
1078 (with-dataset *ds-employees*
1079 (let* ((emp1 (car (select 'employee
1080 :where [= [slot-value 'employee 'emplid]
1084 (height (slot-value emp1 'height)))
1087 (setf (slot-value emp1 'height) 1.0F0)
1088 (clsql:update-record-from-slot emp1 'height)
1089 (= (car (clsql:select [height] :from [employee]
1090 :where [= [emplid] 1]
1094 (setf (slot-value emp1 'height) height)
1095 (clsql:update-record-from-slot emp1 'height))))
1098 (deftest :oodml/float/4
1099 (with-dataset *ds-employees*
1100 (let* ((emp1 (car (select 'employee
1101 :where [= [slot-value 'employee 'emplid]
1105 (height (slot-value emp1 'height)))
1108 (setf (slot-value emp1 'height) 1.0D0)
1109 (clsql:update-record-from-slot emp1 'height)
1110 (= (car (clsql:select [height] :from [employee]
1111 :where [= [emplid] 1]
1115 (setf (slot-value emp1 'height) height)
1116 (clsql:update-record-from-slot emp1 'height))))
1119 (deftest :oodml/float/5
1120 (with-dataset *ds-employees*
1121 (let* ((emp1 (car (select 'employee
1122 :where [= [slot-value 'employee 'emplid]
1126 (height (slot-value emp1 'height)))
1129 (setf (slot-value emp1 'height) 1.0L0)
1130 (clsql:update-record-from-slot emp1 'height)
1131 (= (car (clsql:select [height] :from [employee]
1132 :where [= [emplid] 1]
1136 (setf (slot-value emp1 'height) height)
1137 (clsql:update-record-from-slot emp1 'height))))
1143 #.(clsql:restore-sql-reader-syntax-state)