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
7 ;;;; Tests for the CLSQL Object Oriented Data Definition Language
10 ;;;; This file is part of CLSQL.
12 ;;;; CLSQL users are granted the rights to distribute and use this software
13 ;;;; as governed by the terms of the Lisp Lesser GNU Public License
14 ;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL.
15 ;;;; ======================================================================
17 (in-package #:clsql-tests)
19 #.(clsql:locally-enable-sql-reader-syntax)
24 (deftest :oodml/select/1
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 (mapcar #'(lambda (e) (slot-value e 'name))
32 (clsql:select 'company :flatp t :caching nil))
35 (deftest :oodml/select/3
36 (mapcar #'(lambda (e) (slot-value e 'ecompanyid))
37 (clsql:select 'employee
38 :where [and [= [slot-value 'employee 'ecompanyid]
39 [slot-value 'company 'companyid]]
40 [= [slot-value 'company 'name]
44 (1 1 1 1 1 1 1 1 1 1))
46 (deftest :oodml/select/4
48 (concatenate 'string (slot-value e 'first-name)
50 (slot-value e 'last-name)))
51 (clsql:select 'employee :where [= [slot-value 'employee 'first-name]
56 ("Vladimir Lenin" "Vladimir Putin"))
58 (deftest :oodml/select/5
59 (length (clsql:select 'employee :where [married] :flatp t :caching nil))
62 (deftest :oodml/select/6
63 (let ((a (caar (clsql:select 'address :where [= 1 [addressid]] :caching nil))))
65 (slot-value a 'street-number)
66 (slot-value a 'street-name)
68 (slot-value a 'postal-code)))
69 10 "Park Place" "Leningrad" 123)
71 (deftest :oodml/select/7
72 (let ((a (caar (clsql:select 'address :where [= 2 [addressid]] :caching nil))))
74 (slot-value a 'street-number)
75 (slot-value a 'street-name)
77 (slot-value a 'postal-code)))
80 (deftest :oodml/select/8
81 (mapcar #'(lambda (e) (slot-value e 'married))
82 (clsql:select 'employee :flatp t :order-by [emplid] :caching nil))
83 (t t t nil nil nil nil nil nil nil))
85 (deftest :oodml/select/9
86 (mapcar #'(lambda (pair)
88 (typep (car pair) 'address)
89 (typep (second pair) 'employee-address)
90 (slot-value (car pair) 'addressid)
91 (slot-value (second pair) 'aaddressid)
92 (slot-value (second pair) 'aemplid)))
93 (employee-addresses employee1))
94 ((t t 1 1 1) (t t 2 2 1)))
96 (deftest :oodml/select/10
97 (mapcar #'(lambda (pair)
99 (typep (car pair) 'address)
100 (typep (second pair) 'employee-address)
101 (slot-value (car pair) 'addressid)
102 (slot-value (second pair) 'aaddressid)
103 (slot-value (second pair) 'aemplid)))
104 (employee-addresses employee2))
107 (deftest :oodml/select/11
108 (values (mapcar #'(lambda (x) (slot-value x 'emplid))
109 (clsql:select 'employee :order-by '(([emplid] :asc))
111 (mapcar #'(lambda (x) (slot-value x 'emplid))
112 (clsql:select 'employee :order-by '(([emplid] :desc))
114 (1 2 3 4 5 6 7 8 9 10)
115 (10 9 8 7 6 5 4 3 2 1))
117 ;; test retrieval of node, derived nodes etc
118 (deftest :oodml/select/12
119 (length (clsql:select 'node :where [node-id] :flatp t :caching nil))
122 (deftest :oodml/select/13
123 (let ((a (car (clsql:select 'node :where [= 1 [node-id]] :flatp t :caching nil))))
125 (slot-value a 'node-id)
126 (slot-value a 'title)))
129 (deftest :oodml/select/14
130 (length (clsql:select 'setting :where [setting-id] :flatp t :caching nil))
133 (deftest :oodml/select/15
134 (let ((a (car (clsql:select 'setting :where [= 3 [setting-id]] :flatp t :caching nil))))
136 (slot-value a 'node-id)
137 (slot-value a 'setting-id)
138 (slot-value a 'title)
139 (slot-value a 'vars)))
140 3 3 "Setting2" "var 2")
142 (deftest :oodml/select/16
143 (length (clsql:select 'user :where [user-id] :flatp t :caching nil))
146 (deftest :oodml/select/17
147 (let ((a (car (clsql:select 'user :where [= 4 [user-id]] :flatp t :caching nil))))
149 (slot-value a 'node-id)
150 (slot-value a 'user-id)
151 (slot-value a 'title)
152 (slot-value a 'nick)))
153 4 4 "user-1" "first user")
155 (deftest :oodml/select/18
156 (length (clsql:select 'theme :where [theme-id] :flatp t :caching nil))
159 (deftest :oodml/select/19
160 (let ((a (car (clsql:select 'theme :where [= 6 [theme-id]] :flatp t :caching nil))))
161 (slot-value a 'theme-id))
164 (deftest :oodml/select/20
165 (let ((a (car (clsql:select 'theme :where [= 7 [theme-id]] :flatp t :caching nil))))
167 (slot-value a 'node-id)
168 (slot-value a 'theme-id)
169 (slot-value a 'title)
176 ;; Some tests to check weird subclassed nodes (node without own table, or subclassed of same)
177 (deftest :oodml/select/21
178 (let ((a (car (clsql:select 'location :where [= [title] "location-1"] :flatp t :caching nil))))
180 (slot-value a 'node-id)
181 (slot-value a 'title)))
184 (deftest :oodml/select/22
185 (let ((a (car (clsql:select 'subloc :where [subloc-id] :flatp t :caching nil))))
187 (slot-value a 'node-id)
188 (slot-value a 'subloc-id)
189 (slot-value a 'title)
190 (slot-value a 'loc)))
191 10 10 "subloc-1" "a subloc")
193 ;; test retrieval is deferred
194 (deftest :oodm/retrieval/1
195 (every #'(lambda (e) (not (slot-boundp e 'company)))
196 (select 'employee :flatp t :caching nil))
199 (deftest :oodm/retrieval/2
200 (every #'(lambda (e) (not (slot-boundp e 'address)))
201 (select 'deferred-employee-address :flatp t :caching nil))
204 ;; :retrieval :immediate should be boundp before accessed
205 (deftest :oodm/retrieval/3
206 (every #'(lambda (ea) (slot-boundp ea 'address))
207 (select 'employee-address :flatp t :caching nil))
210 (deftest :oodm/retrieval/4
211 (mapcar #'(lambda (ea) (typep (slot-value ea 'address) 'address))
212 (select 'employee-address :flatp t :caching nil))
215 (deftest :oodm/retrieval/5
216 (mapcar #'(lambda (ea) (typep (slot-value ea 'address) 'address))
217 (select 'deferred-employee-address :flatp t :caching nil))
220 (deftest :oodm/retrieval/6
221 (every #'(lambda (ea) (slot-boundp (slot-value ea 'address) 'addressid))
222 (select 'employee-address :flatp t :caching nil))
225 (deftest :oodm/retrieval/7
226 (every #'(lambda (ea) (slot-boundp (slot-value ea 'address) 'addressid))
227 (select 'deferred-employee-address :flatp t :caching nil))
230 (deftest :oodm/retrieval/8
231 (mapcar #'(lambda (ea) (slot-value (slot-value ea 'address) 'street-number))
232 (select 'employee-address :flatp t :order-by [aaddressid] :caching nil))
235 (deftest :oodm/retrieval/9
236 (mapcar #'(lambda (ea) (slot-value (slot-value ea 'address) 'street-number))
237 (select 'deferred-employee-address :flatp t :order-by [aaddressid] :caching nil))
240 ;; tests update-records-from-instance
241 (deftest :oodml/update-records/1
244 (let ((lenin (car (clsql:select 'employee
245 :where [= [slot-value 'employee 'emplid]
254 (employee-email lenin))))
256 (setf (slot-value employee1 'first-name) "Dimitriy"
257 (slot-value employee1 'last-name) "Ivanovich"
258 (slot-value employee1 'email) "ivanovich@soviet.org")
259 (clsql:update-records-from-instance employee1)
260 (let ((lenin (car (clsql:select 'employee
261 :where [= [slot-value 'employee 'emplid]
270 (employee-email lenin))))
272 (setf (slot-value employee1 'first-name) "Vladimir"
273 (slot-value employee1 'last-name) "Lenin"
274 (slot-value employee1 'email) "lenin@soviet.org")
275 (clsql:update-records-from-instance employee1)
276 (let ((lenin (car (clsql:select 'employee
277 :where [= [slot-value 'employee 'emplid]
286 (employee-email lenin)))))
287 "Vladimir Lenin: lenin@soviet.org"
288 "Dimitriy Ivanovich: ivanovich@soviet.org"
289 "Vladimir Lenin: lenin@soviet.org")
291 ;; tests update-record-from-slot
292 (deftest :oodml/update-records/2
295 (car (clsql:select 'employee
296 :where [= [slot-value 'employee 'emplid] 1]
300 (setf (slot-value employee1 'email) "lenin-nospam@soviet.org")
301 (clsql:update-record-from-slot employee1 'email)
303 (car (clsql:select 'employee
304 :where [= [slot-value 'employee 'emplid] 1]
308 (setf (slot-value employee1 'email) "lenin@soviet.org")
309 (clsql:update-record-from-slot employee1 'email)
311 (car (clsql:select 'employee
312 :where [= [slot-value 'employee 'emplid] 1]
315 "lenin@soviet.org" "lenin-nospam@soviet.org" "lenin@soviet.org")
317 ;; tests update-record-from-slots
318 (deftest :oodml/update-records/3
320 (let ((lenin (car (clsql:select 'employee
321 :where [= [slot-value 'employee 'emplid]
330 (employee-email lenin)))
332 (setf (slot-value employee1 'first-name) "Dimitriy"
333 (slot-value employee1 'last-name) "Ivanovich"
334 (slot-value employee1 'email) "ivanovich@soviet.org")
335 (clsql:update-record-from-slots employee1 '(first-name last-name email))
336 (let ((lenin (car (clsql:select 'employee
337 :where [= [slot-value 'employee 'emplid]
346 (employee-email lenin))))
348 (setf (slot-value employee1 'first-name) "Vladimir"
349 (slot-value employee1 'last-name) "Lenin"
350 (slot-value employee1 'email) "lenin@soviet.org")
351 (clsql:update-record-from-slots employee1 '(first-name last-name email))
352 (let ((lenin (car (clsql:select 'employee
353 :where [= [slot-value 'employee 'emplid]
362 (employee-email lenin)))))
363 "Vladimir Lenin: lenin@soviet.org"
364 "Dimitriy Ivanovich: ivanovich@soviet.org"
365 "Vladimir Lenin: lenin@soviet.org")
367 (deftest :oodml/update-records/4
368 (flet ((print-fresh-node ()
369 (let ((base (car (clsql:select 'node
370 :where [= 1 [slot-value 'node 'node-id]]
371 :flatp t :caching nil))))
373 (slot-value base 'node-id)
374 (slot-value base 'title)))))
377 (let ((base (car (clsql:select 'node
378 :where [= 1 [slot-value 'node 'node-id]]
379 :flatp t :caching nil))))
380 (setf (slot-value base 'title) "Altered title")
381 (clsql:update-records-from-instance base)
383 (let ((base (car (clsql:select 'node
384 :where [= 1 [slot-value 'node 'node-id]]
385 :flatp t :caching nil))))
386 (setf (slot-value base 'title) "Bare node")
387 (clsql:update-records-from-instance base)
388 (print-fresh-node))))
393 (deftest :oodml/update-records/4-slots ;just like 4, but use slots fns.
394 (flet ((print-fresh-setting ()
395 (let ((node (car (clsql:select 'setting
396 :where [= 3 [slot-value 'setting 'setting-id]]
397 :flatp t :caching nil))))
398 (format nil "~a ~a ~a"
399 (slot-value node 'setting-id)
400 (slot-value node 'title)
401 (slot-value node 'vars)))))
403 (print-fresh-setting)
404 (let ((node (car (clsql:select 'setting
405 :where [= 3 [slot-value 'setting 'setting-id]]
406 :flatp t :caching nil))))
407 (setf (slot-value node 'title) "Altered title")
408 (setf (slot-value node 'vars) "Altered vars")
409 (clsql-sys:update-record-from-slot node 'title)
410 (clsql-sys:update-record-from-slot node 'vars)
411 (print-fresh-setting))
412 (let ((node (car (clsql:select 'setting
413 :where [= 3 [slot-value 'setting 'setting-id]]
414 :flatp t :caching nil))))
415 (setf (slot-value node 'title) "Setting2")
416 (setf (slot-value node 'vars) "var 2")
417 (clsql:update-records-from-instance node)
418 (clsql-sys:update-record-from-slots node '(vars title))
419 (print-fresh-setting))))
421 "3 Altered title Altered vars"
424 (deftest :oodml/update-records/5
425 (flet ((print-fresh-setting ()
426 (let ((node (car (clsql:select 'setting
427 :where [= 3 [slot-value 'setting 'setting-id]]
428 :flatp t :caching nil))))
429 (format nil "~a ~a ~a"
430 (slot-value node 'setting-id)
431 (slot-value node 'title)
432 (slot-value node 'vars)))))
434 (print-fresh-setting)
435 (let ((node (car (clsql:select 'setting
436 :where [= 3 [slot-value 'setting 'setting-id]]
437 :flatp t :caching nil))))
438 (setf (slot-value node 'title) "Altered title")
439 (setf (slot-value node 'vars) "Altered vars")
440 (clsql:update-records-from-instance node)
441 (print-fresh-setting))
442 (let ((node (car (clsql:select 'setting
443 :where [= 3 [slot-value 'setting 'setting-id]]
444 :flatp t :caching nil))))
445 (setf (slot-value node 'title) "Setting2")
446 (setf (slot-value node 'vars) "var 2")
447 (clsql:update-records-from-instance node)
448 (print-fresh-setting))))
450 "3 Altered title Altered vars"
453 (deftest :oodml/update-records/5-slots
454 (flet ((print-fresh-setting ()
455 (let ((node (car (clsql:select 'setting
456 :where [= 3 [slot-value 'setting 'setting-id]]
457 :flatp t :caching nil))))
458 (format nil "~a ~a ~a"
459 (slot-value node 'setting-id)
460 (slot-value node 'title)
461 (slot-value node 'vars)))))
463 (print-fresh-setting)
464 (let ((node (car (clsql:select 'setting
465 :where [= 3 [slot-value 'setting 'setting-id]]
466 :flatp t :caching nil))))
467 (setf (slot-value node 'title) "Altered title")
468 (setf (slot-value node 'vars) "Altered vars")
469 (clsql-sys:update-record-from-slot node 'title)
470 (clsql-sys:update-record-from-slot node 'vars)
471 (print-fresh-setting))
472 (let ((node (car (clsql:select 'setting
473 :where [= 3 [slot-value 'setting 'setting-id]]
474 :flatp t :caching nil))))
475 (setf (slot-value node 'title) "Setting2")
476 (setf (slot-value node 'vars) "var 2")
477 (clsql-sys:update-record-from-slots node '(title vars))
478 (print-fresh-setting))))
480 "3 Altered title Altered vars"
483 (deftest :oodml/update-records/6
484 (flet ((print-fresh-setting ()
485 (let ((node (car (clsql:select 'setting
486 :where [= 7 [slot-value 'setting 'setting-id]]
487 :flatp t :caching nil))))
488 (format nil "~a ~a ~a"
489 (slot-value node 'setting-id)
490 (slot-value node 'title)
491 (slot-value node 'vars)))))
493 (print-fresh-setting)
494 (let ((node (car (clsql:select 'setting
495 :where [= 7 [slot-value 'setting 'setting-id]]
496 :flatp t :caching nil))))
497 (setf (slot-value node 'title) "Altered title")
498 (setf (slot-value node 'vars) "Altered vars")
499 (clsql:update-records-from-instance node)
500 (print-fresh-setting))
501 (let ((node (car (clsql:select 'setting
502 :where [= 7 [slot-value 'setting 'setting-id]]
503 :flatp t :caching nil))))
504 (setf (slot-value node 'title) "theme-2")
505 (setf (slot-value node 'vars) nil)
506 (clsql:update-records-from-instance node)
507 (print-fresh-setting))))
509 "7 Altered title Altered vars"
512 (deftest :oodml/update-records/7
513 (flet ((print-fresh-user ()
514 "requery to get what the db has, and print out."
515 (let ((node (car (clsql:select 'user
516 :where [= 5 [slot-value 'user 'user-id]]
517 :flatp t :caching nil))))
518 (format nil "~a ~a ~a"
519 (slot-value node 'user-id)
520 (slot-value node 'title)
521 (slot-value node 'nick)))))
524 (let ((node (car (clsql:select 'user
525 :where [= 5 [slot-value 'user 'user-id]]
526 :flatp t :caching nil))))
527 (setf (slot-value node 'title) "Altered title")
528 (setf (slot-value node 'nick) "Altered nick")
529 (clsql:update-records-from-instance node)
531 (let ((node (car (clsql:select 'user
532 :where [= 5 [slot-value 'user 'user-id]]
533 :flatp t :caching nil))))
534 (setf (slot-value node 'title) "user-2")
535 (setf (slot-value node 'nick) "second user")
536 (clsql:update-records-from-instance node)
537 (print-fresh-user))))
538 "5 user-2 second user"
539 "5 Altered title Altered nick"
540 "5 user-2 second user")
542 (deftest :oodml/update-records/8
543 (flet ((print-fresh-theme ()
544 (let ((node (car (clsql:select 'theme
545 :where [= 6 [slot-value 'theme 'theme-id]]
546 :flatp t :caching nil))))
547 (format nil "~a ~a ~a ~a ~a ~a"
548 (slot-value node 'node-id)
549 (slot-value node 'setting-id)
550 (slot-value node 'theme-id)
551 (slot-value node 'title)
552 (slot-value node 'vars)
553 (slot-value node 'doc)))))
556 (let ((node (car (clsql:select 'setting
557 :where [= 6 [slot-value 'setting 'setting-id]]
558 :flatp t :caching nil))))
559 (setf (slot-value node 'title) "Altered title")
560 (setf (slot-value node 'vars) nil)
561 (clsql:update-records-from-instance node)
563 (let ((node (car (clsql:select 'theme
564 :where [= 6 [slot-value 'theme 'theme-id]]
565 :flatp t :caching nil))))
566 (setf (slot-value node 'title) "Altered title again")
567 (setf (slot-value node 'doc) "altered doc")
568 (clsql:update-records-from-instance node)
570 (let ((node (car (clsql:select 'theme
571 :where [= 6 [slot-value 'theme 'theme-id]]
572 :flatp t :caching nil))))
573 (setf (slot-value node 'title) "theme-1")
574 (setf (slot-value node 'vars) "empty")
575 (setf (slot-value node 'doc) "first theme")
576 (clsql:update-records-from-instance node)
577 (print-fresh-theme))))
578 "6 6 6 theme-1 empty first theme"
579 "6 6 6 Altered title NIL first theme"
580 "6 6 6 Altered title again NIL altered doc"
581 "6 6 6 theme-1 empty first theme")
583 (deftest :oodml/update-records/9
584 (flet ((print-fresh-subloc ()
585 (let ((sl (car (clsql:select 'subloc
586 :where [= 10 [slot-value 'subloc 'subloc-id]]
587 :flatp t :caching nil))))
588 (format nil "~a ~a ~a"
589 (slot-value sl 'subloc-id)
590 (slot-value sl 'title)
591 (slot-value sl 'loc)))))
594 (let ((sl (car (clsql:select 'subloc
595 :where [= 10 [slot-value 'subloc 'subloc-id]]
596 :flatp t :caching nil))))
597 (setf (slot-value sl 'title) "Altered subloc title")
598 (setf (slot-value sl 'loc) "Altered loc")
599 (clsql:update-records-from-instance sl)
600 (print-fresh-subloc))
601 (let ((sl (car (clsql:select 'subloc
602 :where [= 10 [slot-value 'subloc 'subloc-id]]
603 :flatp t :caching nil))))
604 (setf (slot-value sl 'title) "subloc-1")
605 (setf (slot-value sl 'loc) "a subloc")
606 (clsql:update-records-from-instance sl)
607 (print-fresh-subloc))))
608 "10 subloc-1 a subloc"
609 "10 Altered subloc title Altered loc"
610 "10 subloc-1 a subloc")
612 (deftest :oodml/update-records/9-slots ;like 9, but use slots fns.
613 (flet ((print-fresh-subloc ()
614 (let ((sl (car (clsql:select 'subloc
615 :where [= 10 [slot-value 'subloc 'subloc-id]]
616 :flatp t :caching nil))))
617 (format nil "~a ~a ~a"
618 (slot-value sl 'subloc-id)
619 (slot-value sl 'title)
620 (slot-value sl 'loc)))))
623 (let ((sl (car (clsql:select 'subloc
624 :where [= 10 [slot-value 'subloc 'subloc-id]]
625 :flatp t :caching nil))))
626 (setf (slot-value sl 'title) "Altered subloc title")
627 (setf (slot-value sl 'loc) "Altered loc")
628 (clsql:update-record-from-slot sl 'title)
629 (clsql:update-record-from-slot sl 'loc)
630 (print-fresh-subloc))
631 (let ((sl (car (clsql:select 'subloc
632 :where [= 10 [slot-value 'subloc 'subloc-id]]
633 :flatp t :caching nil))))
634 (setf (slot-value sl 'title) "subloc-1")
635 (setf (slot-value sl 'loc) "a subloc")
636 (clsql:update-record-from-slot sl '(title loc))
637 (print-fresh-subloc))))
638 "10 subloc-1 a subloc"
639 "10 Altered subloc title Altered loc"
640 "10 subloc-1 a subloc")
643 ;; tests update-instance-from-records
644 (deftest :oodml/update-instance/1
647 (slot-value employee1 'first-name)
649 (slot-value employee1 'last-name)
651 (slot-value employee1 'email))
653 (clsql:update-records [employee]
654 :av-pairs '(([first-name] "Ivan")
655 ([last-name] "Petrov")
656 ([email] "petrov@soviet.org"))
657 :where [= [emplid] 1])
658 (clsql:update-instance-from-records employee1)
660 (slot-value employee1 'first-name)
662 (slot-value employee1 'last-name)
664 (slot-value employee1 'email)))
666 (clsql:update-records [employee]
667 :av-pairs '(([first-name] "Vladimir")
668 ([last-name] "Lenin")
669 ([email] "lenin@soviet.org"))
670 :where [= [emplid] 1])
671 (clsql:update-instance-from-records employee1)
673 (slot-value employee1 'first-name)
675 (slot-value employee1 'last-name)
677 (slot-value employee1 'email))))
678 "Vladimir Lenin: lenin@soviet.org"
679 "Ivan Petrov: petrov@soviet.org"
680 "Vladimir Lenin: lenin@soviet.org")
682 ;; tests update-slot-from-record
683 (deftest :oodml/update-instance/2
685 (slot-value employee1 'email)
687 (clsql:update-records [employee]
688 :av-pairs '(([email] "lenin-nospam@soviet.org"))
689 :where [= [emplid] 1])
690 (clsql:update-slot-from-record employee1 'email)
691 (slot-value employee1 'email))
693 (clsql:update-records [employee]
694 :av-pairs '(([email] "lenin@soviet.org"))
695 :where [= [emplid] 1])
696 (clsql:update-slot-from-record employee1 'email)
697 (slot-value employee1 'email)))
698 "lenin@soviet.org" "lenin-nospam@soviet.org" "lenin@soviet.org")
700 ;; tests normalisedp update-instance-from-records
701 (deftest :oodml/update-instance/3
703 (with-output-to-string (out)
704 (format out "~a ~a ~a ~a"
705 (slot-value theme2 'theme-id)
706 (slot-value theme2 'title)
707 (slot-value theme2 'vars)
708 (slot-value theme2 'doc)))
710 (clsql:update-records [node] :av-pairs '(([title] "Altered title"))
711 :where [= [node-id] 7])
712 (clsql:update-records [setting] :av-pairs '(([vars] "Altered vars"))
713 :where [= [setting-id] 7])
714 (clsql:update-records [theme] :av-pairs '(([doc] "Altered doc"))
715 :where [= [theme-id] 7])
716 (clsql:update-instance-from-records theme2)
717 (with-output-to-string (out)
718 (format out "~a ~a ~a ~a"
719 (slot-value theme2 'theme-id)
720 (slot-value theme2 'title)
721 (slot-value theme2 'vars)
722 (slot-value theme2 'doc))))
724 (clsql:update-records [node] :av-pairs '(([title] "theme-2"))
725 :where [= [node-id] 7])
726 (clsql:update-records [setting] :av-pairs '(([vars] nil))
727 :where [= [setting-id] 7])
728 (clsql:update-records [theme] :av-pairs '(([doc] "second theme"))
729 :where [= [theme-id] 7])
730 (clsql:update-instance-from-records theme2)
731 (with-output-to-string (out)
732 (format out "~a ~a ~a ~a"
733 (slot-value theme2 'theme-id)
734 (slot-value theme2 'title)
735 (slot-value theme2 'vars)
736 (slot-value theme2 'doc)))))
737 "7 theme-2 NIL second theme"
738 "7 Altered title Altered vars Altered doc"
739 "7 theme-2 NIL second theme")
741 (deftest :oodml/update-instance/4
744 (setf loc2 (car (clsql:select 'location
745 :where [= [node-id] 9]
746 :flatp t :caching nil)))
748 (slot-value loc2 'node-id)
749 (slot-value loc2 'title)))
751 (clsql:update-records [node] :av-pairs '(([title] "Altered title"))
752 :where [= [node-id] 9])
753 (clsql:update-instance-from-records loc2)
755 (slot-value loc2 'node-id)
756 (slot-value loc2 'title)))
758 (clsql:update-records [node] :av-pairs '(([title] "location-2"))
759 :where [= [node-id] 9])
760 (clsql:update-instance-from-records loc2)
762 (slot-value loc2 'node-id)
763 (slot-value loc2 'title))))
768 (deftest :oodml/update-instance/5
770 (format nil "~a ~a ~a"
771 (slot-value subloc2 'subloc-id)
772 (slot-value subloc2 'title)
773 (slot-value subloc2 'loc))
775 (clsql:update-records [node] :av-pairs '(([title] "Altered title"))
776 :where [= [node-id] 11])
777 (clsql:update-records [subloc] :av-pairs '(([loc] "Altered loc"))
778 :where [= [subloc-id] 11])
779 (clsql:update-instance-from-records subloc2)
780 (format nil "~a ~a ~a"
781 (slot-value subloc2 'subloc-id)
782 (slot-value subloc2 'title)
783 (slot-value subloc2 'loc)))
785 (clsql:update-records [node] :av-pairs '(([title] "subloc-2"))
786 :where [= [node-id] 11])
787 (clsql:update-records [subloc] :av-pairs '(([loc] "second subloc"))
788 :where [= [subloc-id] 11])
789 (clsql:update-instance-from-records subloc2)
790 (format nil "~a ~a ~a"
791 (slot-value subloc2 'subloc-id)
792 (slot-value subloc2 'title)
793 (slot-value subloc2 'loc))))
794 "11 subloc-2 second subloc"
795 "11 Altered title Altered loc"
796 "11 subloc-2 second subloc")
798 ;; tests update-slot-from-record with normalisedp stuff
799 (deftest :oodml/update-instance/6
801 (slot-value theme1 'doc)
802 (slot-value theme1 'vars)
804 (clsql:update-records [theme]
805 :av-pairs '(([doc] "altered doc"))
806 :where [= [theme-id] 6])
807 (clsql:update-slot-from-record theme1 'doc)
808 (slot-value theme1 'doc))
810 (clsql:update-records [setting]
811 :av-pairs '(([vars] "altered vars"))
812 :where [= [setting-id] 6])
813 (clsql:update-slot-from-record theme1 'vars)
814 (slot-value theme1 'vars))
816 (clsql:update-records [theme]
817 :av-pairs '(([doc] "first theme"))
818 :where [= [theme-id] 6])
819 (clsql:update-slot-from-record theme1 'doc)
820 (slot-value theme1 'doc))
822 (clsql:update-records [setting]
823 :av-pairs '(([vars] "empty"))
824 :where [= [setting-id] 6])
825 (clsql:update-slot-from-record theme1 'vars)
826 (slot-value theme1 'vars)))
827 "first theme" "empty"
828 "altered doc" "altered vars"
829 "first theme" "empty")
831 (deftest :oodml/update-instance/7
833 (slot-value loc2 'title)
834 (slot-value subloc2 'loc)
836 (clsql:update-records [node]
837 :av-pairs '(([title] "altered title"))
838 :where [= [node-id] 9])
839 (clsql:update-slot-from-record loc2 'title)
840 (slot-value loc2 'title))
842 (clsql:update-records [subloc]
843 :av-pairs '(([loc] "altered loc"))
844 :where [= [subloc-id] 11])
845 (clsql:update-slot-from-record subloc2 'loc)
846 (slot-value subloc2 'loc))
848 (clsql:update-records [node]
849 :av-pairs '(([title] "location-2"))
850 :where [= [node-id] 9])
851 (clsql:update-slot-from-record loc2 'title)
852 (slot-value loc2 'title))
854 (clsql:update-records [subloc]
855 :av-pairs '(([loc] "second subloc"))
856 :where [= [subloc-id] 11])
857 (clsql:update-slot-from-record subloc2 'loc)
858 (slot-value subloc2 'loc)))
859 "location-2" "second subloc"
860 "altered title" "altered loc"
861 "location-2" "second subloc")
863 (deftest :oodml/do-query/1
865 (clsql:do-query ((e) [select 'employee :order-by [emplid]])
866 (push (slot-value e 'last-name) result))
868 ("Putin" "Yeltsin" "Gorbachev" "Chernenko" "Andropov" "Brezhnev" "Kruschev"
869 "Trotsky" "Stalin" "Lenin"))
871 (deftest :oodml/do-query/2
873 (clsql:do-query ((e c) [select 'employee 'company
874 :where [= [slot-value 'employee 'last-name]
876 (push (list (slot-value e 'last-name) (slot-value c 'name))
879 (("Lenin" "Widgets Inc.")))
881 (deftest :oodml/map-query/1
882 (clsql:map-query 'list #'last-name [select 'employee :order-by [emplid]])
883 ("Lenin" "Stalin" "Trotsky" "Kruschev" "Brezhnev" "Andropov" "Chernenko"
884 "Gorbachev" "Yeltsin" "Putin"))
886 (deftest :oodml/map-query/2
887 (clsql:map-query 'list #'(lambda (e c) (list (slot-value e 'last-name)
888 (slot-value c 'name)))
889 [select 'employee 'company :where [= [slot-value 'employee 'last-name]
891 (("Lenin" "Widgets Inc.")))
893 (deftest :oodml/iteration/3
894 (loop for (e) being the records in
895 [select 'employee :where [< [emplid] 4] :order-by [emplid]]
896 collect (slot-value e 'last-name))
897 ("Lenin" "Stalin" "Trotsky"))
900 (deftest :oodml/cache/1
902 (setf (clsql-sys:record-caches *default-database*) nil)
903 (let ((employees (select 'employee)))
904 (every #'(lambda (a b) (eq a b))
905 employees (select 'employee))))
908 (deftest :oodml/cache/2
909 (let ((employees (select 'employee)))
910 (equal employees (select 'employee :flatp t)))
913 (deftest :oodml/refresh/1
914 (let ((addresses (select 'address)))
915 (equal addresses (select 'address :refresh t)))
918 (deftest :oodml/refresh/2
919 (let* ((addresses (select 'address :order-by [addressid] :flatp t :refresh t))
920 (city (slot-value (car addresses) 'city)))
921 (clsql:update-records [addr]
922 :av-pairs '((city_field "A new city"))
923 :where [= [addressid] (slot-value (car addresses) 'addressid)])
924 (let* ((new-addresses (select 'address :order-by [addressid] :refresh t :flatp t))
925 (new-city (slot-value (car addresses) 'city))
927 (clsql:update-records [addr]
928 :av-pairs `((city_field ,city))
929 :where [= [addressid] (slot-value (car addresses) 'addressid)])
930 (values (equal addresses new-addresses)
933 t "Leningrad" "A new city")
935 (deftest :oodml/refresh/3
936 (let* ((addresses (select 'address :order-by [addressid] :flatp t)))
938 (equal addresses (select 'address :refresh t :flatp t))
939 (equal addresses (select 'address :flatp t))))
942 (deftest :oodml/refresh/4
943 (let* ((addresses (select 'address :order-by [addressid] :flatp t :refresh t))
945 (make-instance 'address :addressid 1000 :city "A new address city")
946 (let ((new-addresses (select 'address :order-by [addressid] :flatp t :refresh t)))
947 (delete-records :from [addr] :where [= [addressid] 1000])
950 (length new-addresses)
951 (eq (first addresses) (first new-addresses))
952 (eq (second addresses) (second new-addresses)))))
956 (deftest :oodml/uoj/1
958 (let* ((dea-list (select 'deferred-employee-address :caching nil :order-by ["ea_join" aaddressid]
960 (dea-list-copy (copy-seq dea-list))
961 (initially-unbound (every #'(lambda (dea) (not (slot-boundp dea 'address))) dea-list)))
962 (update-objects-joins dea-list)
965 (equal dea-list dea-list-copy)
966 (every #'(lambda (dea) (slot-boundp dea 'address)) dea-list)
967 (every #'(lambda (dea) (typep (slot-value dea 'address) 'address)) dea-list)
968 (mapcar #'(lambda (dea) (slot-value (slot-value dea 'address) 'addressid)) dea-list))))
971 ;; update-object-joins needs to be fixed for multiple keys
973 (deftest :oodml/uoj/2
975 (clsql:update-objects-joins (list company1))
976 (mapcar #'(lambda (e)
977 (slot-value e 'ecompanyid))
978 (company-employees company1)))
979 (1 1 1 1 1 1 1 1 1 1))
981 (deftest :oodml/big/1
982 (let ((objs (clsql:select 'big :order-by [i] :flatp t)))
987 (rest objs (cdr rest)))
988 ((= i (length objs)) t)
989 (let ((obj (car rest))
991 (unless (and (eql (slot-value obj 'i) index)
992 (eql (slot-value obj 'bi) (truncate max index)))
998 (deftest :oodml/db-auto-sync/1
1001 (make-instance 'employee :emplid 20 :groupid 1
1002 :last-name "Ivanovich")
1003 (select [last-name] :from [employee] :where [= [emplid] 20]
1004 :flatp t :field-names nil))
1005 (let ((*db-auto-sync* t))
1006 (make-instance 'employee :emplid 20 :groupid 1
1007 :last-name "Ivanovich")
1008 (prog1 (select [last-name] :from [employee] :flatp t
1010 :where [= [emplid] 20])
1011 (delete-records :from [employee] :where [= [emplid] 20]))))
1014 (deftest :oodml/db-auto-sync/2
1016 (let ((instance (make-instance 'employee :emplid 20 :groupid 1
1017 :last-name "Ivanovich")))
1018 (setf (slot-value instance 'last-name) "Bulgakov")
1019 (select [last-name] :from [employee] :where [= [emplid] 20]
1020 :flatp t :field-names nil))
1021 (let* ((*db-auto-sync* t)
1022 (instance (make-instance 'employee :emplid 20 :groupid 1
1023 :last-name "Ivanovich")))
1024 (setf (slot-value instance 'last-name) "Bulgakov")
1025 (prog1 (select [last-name] :from [employee] :flatp t
1027 :where [= [emplid] 20])
1028 (delete-records :from [employee] :where [= [emplid] 20]))))
1031 (deftest :oodml/db-auto-sync/3
1034 (make-instance 'theme :title "test-theme" :vars "test-vars"
1036 (select [node-id] :from [node] :where [= [title] "test-theme"]
1037 :flatp t :field-names nil))
1038 (let ((*db-auto-sync* t))
1039 (make-instance 'theme :title "test-theme" :vars "test-vars"
1041 (prog1 (select [title] :from [node] :where [= [title] "test-theme"]
1042 :flatp t :field-names nil)
1043 (delete-records :from [node] :where [= [title] "test-theme"])
1044 (delete-records :from [setting] :where [= [vars] "test-vars"])
1045 (delete-records :from [theme] :where [= [doc] "test-doc"]))))
1048 (deftest :oodml/db-auto-sync/4
1050 (let ((inst (make-instance 'theme
1051 :title "test-theme" :vars "test-vars"
1053 (setf (slot-value inst 'title) "alternate-test-theme")
1054 (format nil "~a ~a ~a ~a"
1055 (select [title] :from [node]
1056 :where [= [title] "test-theme"]
1057 :flatp t :field-names nil)
1058 (select [vars] :from [setting]
1059 :where [= [vars] "test-vars"]
1060 :flatp t :field-names nil)
1061 (select [doc] :from [theme]
1062 :where [= [doc] "test-doc"]
1063 :flatp t :field-names nil)
1064 (select [title] :from [node]
1065 :where [= [title] "alternate-test-theme"]
1066 :flatp t :field-names nil)))
1067 (let* ((*db-auto-sync* t)
1068 (inst (make-instance 'theme
1069 :title "test-theme" :vars "test-vars"
1071 (setf (slot-value inst 'title) "alternate-test-theme")
1073 (format nil "~a ~a ~a ~a"
1074 (select [title] :from [node]
1075 :where [= [title] "test-theme"]
1076 :flatp t :field-names nil)
1077 (select [vars] :from [setting]
1078 :where [= [vars] "test-vars"]
1079 :flatp t :field-names nil)
1080 (select [doc] :from [theme]
1081 :where [= [doc] "test-doc"]
1082 :flatp t :field-names nil)
1083 (select [title] :from [node]
1084 :where [= [title] "alternate-test-theme"]
1085 :flatp t :field-names nil))
1086 (delete-records :from [node] :where [= [title] "alternate-test-theme"])
1087 (delete-records :from [setting] :where [= [vars] "test-vars"])
1088 (delete-records :from [theme] :where [= [doc] "test-doc"]))))
1090 "NIL (test-vars) (test-doc) (alternate-test-theme)")
1092 (deftest :oodml/setf-slot-value/1
1093 (let* ((*db-auto-sync* t)
1094 (instance (make-instance 'employee :emplid 20 :groupid 1)))
1097 (slot-value instance 'first-name) "Mikhail"
1098 (slot-value instance 'last-name) "Bulgakov")
1099 (delete-records :from [employee] :where [= [emplid] 20])))
1102 (deftest :oodml/float/1
1103 (let* ((emp1 (car (select 'employee
1104 :where [= [slot-value 'employee 'emplid]
1108 (height (slot-value emp1 'height)))
1111 (setf (slot-value emp1 'height) 1.0E0)
1112 (clsql:update-record-from-slot emp1 'height)
1113 (= (car (clsql:select [height] :from [employee]
1114 :where [= [emplid] 1]
1118 (setf (slot-value emp1 'height) height)
1119 (clsql:update-record-from-slot emp1 'height)))
1122 (deftest :oodml/float/2
1123 (let* ((emp1 (car (select 'employee
1124 :where [= [slot-value 'employee 'emplid]
1128 (height (slot-value emp1 'height)))
1131 (setf (slot-value emp1 'height) 1.0S0)
1132 (clsql:update-record-from-slot emp1 'height)
1133 (= (car (clsql:select [height] :from [employee]
1134 :where [= [emplid] 1]
1138 (setf (slot-value emp1 'height) height)
1139 (clsql:update-record-from-slot emp1 'height)))
1142 (deftest :oodml/float/3
1143 (let* ((emp1 (car (select 'employee
1144 :where [= [slot-value 'employee 'emplid]
1148 (height (slot-value emp1 'height)))
1151 (setf (slot-value emp1 'height) 1.0F0)
1152 (clsql:update-record-from-slot emp1 'height)
1153 (= (car (clsql:select [height] :from [employee]
1154 :where [= [emplid] 1]
1158 (setf (slot-value emp1 'height) height)
1159 (clsql:update-record-from-slot emp1 'height)))
1162 (deftest :oodml/float/4
1163 (let* ((emp1 (car (select 'employee
1164 :where [= [slot-value 'employee 'emplid]
1168 (height (slot-value emp1 'height)))
1171 (setf (slot-value emp1 'height) 1.0D0)
1172 (clsql:update-record-from-slot emp1 'height)
1173 (= (car (clsql:select [height] :from [employee]
1174 :where [= [emplid] 1]
1178 (setf (slot-value emp1 'height) height)
1179 (clsql:update-record-from-slot emp1 'height)))
1182 (deftest :oodml/float/5
1183 (let* ((emp1 (car (select 'employee
1184 :where [= [slot-value 'employee 'emplid]
1188 (height (slot-value emp1 'height)))
1191 (setf (slot-value emp1 'height) 1.0L0)
1192 (clsql:update-record-from-slot emp1 'height)
1193 (= (car (clsql:select [height] :from [employee]
1194 :where [= [emplid] 1]
1198 (setf (slot-value emp1 'height) height)
1199 (clsql:update-record-from-slot emp1 'height)))
1204 #.(clsql:restore-sql-reader-syntax-state)