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 ;; test retrieval is deferred
215 (deftest :oodm/retrieval/1
216 (with-dataset *ds-employees*
217 (every #'(lambda (e) (not (slot-boundp e 'company)))
218 (select 'employee :flatp t :caching nil)))
221 (deftest :oodm/retrieval/2
222 (with-dataset *ds-employees*
223 (every #'(lambda (e) (not (slot-boundp e 'address)))
224 (select 'deferred-employee-address :flatp t :caching nil)))
227 ;; :retrieval :immediate should be boundp before accessed
228 (deftest :oodm/retrieval/3
229 (with-dataset *ds-employees*
230 (every #'(lambda (ea) (slot-boundp ea 'address))
231 (select 'employee-address :flatp t :caching nil)))
234 (deftest :oodm/retrieval/4
235 (with-dataset *ds-employees*
236 (mapcar #'(lambda (ea) (typep (slot-value ea 'address) 'address))
237 (select 'employee-address :flatp t :caching nil)))
240 (deftest :oodm/retrieval/5
241 (with-dataset *ds-employees*
242 (mapcar #'(lambda (ea) (typep (slot-value ea 'address) 'address))
243 (select 'deferred-employee-address :flatp t :caching nil)))
246 (deftest :oodm/retrieval/6
247 (with-dataset *ds-employees*
248 (every #'(lambda (ea) (slot-boundp (slot-value ea 'address) 'addressid))
249 (select 'employee-address :flatp t :caching nil)))
252 (deftest :oodm/retrieval/7
253 (with-dataset *ds-employees*
254 (every #'(lambda (ea) (slot-boundp (slot-value ea 'address) 'addressid))
255 (select 'deferred-employee-address :flatp t :caching nil)))
258 (deftest :oodm/retrieval/8
259 (with-dataset *ds-employees*
260 (mapcar #'(lambda (ea) (slot-value (slot-value ea 'address) 'street-number))
261 (select 'employee-address :flatp t :order-by [aaddressid] :caching nil)))
264 (deftest :oodm/retrieval/9
265 (with-dataset *ds-employees*
266 (mapcar #'(lambda (ea) (slot-value (slot-value ea 'address) 'street-number))
267 (select 'deferred-employee-address :flatp t :order-by [aaddressid] :caching nil)))
270 ;; tests update-records-from-instance
271 (deftest :oodml/update-records/1
272 (with-dataset *ds-employees*
275 (let ((lenin (car (clsql:select 'employee
276 :where [= 1 [slot-value 'employee 'emplid]]
279 (format nil "~a ~a: ~a"
282 (employee-email lenin))))
284 (setf (slot-value employee1 'first-name) "Dimitriy"
285 (slot-value employee1 'last-name) "Ivanovich"
286 (slot-value employee1 'email) "ivanovich@soviet.org")
287 (clsql:update-records-from-instance employee1)
288 (let ((lenin (car (clsql:select 'employee
289 :where [= 1 [slot-value 'employee 'emplid]]
292 (format nil "~a ~a: ~a"
295 (employee-email lenin))))))
296 "Vladimir Lenin: lenin@soviet.org"
297 "Dimitriy Ivanovich: ivanovich@soviet.org")
299 ;; tests update-record-from-slot
300 (deftest :oodml/update-records/2
301 (with-dataset *ds-employees*
304 (car (clsql:select 'employee
305 :where [= 1 [slot-value 'employee 'emplid]]
309 (setf (slot-value employee1 'email) "lenin-nospam@soviet.org")
310 (clsql:update-record-from-slot employee1 'email)
312 (car (clsql:select 'employee
313 :where [= 1 [slot-value 'employee 'emplid]]
316 "lenin@soviet.org" "lenin-nospam@soviet.org")
318 ;; tests update-record-from-slots
319 (deftest :oodml/update-records/3
320 (with-dataset *ds-employees*
322 (let ((lenin (car (clsql:select 'employee
323 :where [= 1 [slot-value 'employee 'emplid]]
326 (format nil "~a ~a: ~a"
329 (employee-email lenin)))
331 (setf (slot-value employee1 'first-name) "Dimitriy"
332 (slot-value employee1 'last-name) "Ivanovich"
333 (slot-value employee1 'email) "ivanovich@soviet.org")
334 (clsql:update-record-from-slots employee1 '(first-name last-name email))
335 (let ((lenin (car (clsql:select 'employee
336 :where [= 1 [slot-value 'employee 'emplid]]
339 (format nil "~a ~a: ~a"
342 (employee-email lenin))))))
343 "Vladimir Lenin: lenin@soviet.org"
344 "Dimitriy Ivanovich: ivanovich@soviet.org")
346 (deftest :oodml/update-records/4
347 (with-dataset *ds-nodes*
348 (flet ((print-fresh-node ()
349 (let ((base (car (clsql:select 'node
350 :where [= 1 [slot-value 'node 'node-id]]
351 :flatp t :caching nil))))
353 (slot-value base 'node-id)
354 (slot-value base 'title)))))
357 (let ((base (car (clsql:select 'node
358 :where [= 1 [slot-value 'node 'node-id]]
359 :flatp t :caching nil))))
360 (setf (slot-value base 'title) "Altered title")
361 (clsql:update-records-from-instance base)
362 (print-fresh-node)))))
366 (deftest :oodml/update-records/4-slots ;just like 4, but use slots fns.
367 (with-dataset *ds-nodes*
368 (flet ((print-fresh-setting ()
369 (let ((node (car (clsql:select 'setting
370 :where [= 3 [slot-value 'setting 'setting-id]]
371 :flatp t :caching nil))))
372 (format nil "~a ~a ~a"
373 (slot-value node 'setting-id)
374 (slot-value node 'title)
375 (slot-value node 'vars)))))
377 (print-fresh-setting)
378 (let ((node (car (clsql:select 'setting
379 :where [= 3 [slot-value 'setting 'setting-id]]
380 :flatp t :caching nil))))
381 (setf (slot-value node 'title) "Altered title")
382 (setf (slot-value node 'vars) "Altered vars")
383 (clsql-sys:update-record-from-slot node 'title)
384 (clsql-sys:update-record-from-slot node 'vars)
385 (print-fresh-setting))
386 (let ((node (car (clsql:select 'setting
387 :where [= 3 [slot-value 'setting 'setting-id]]
388 :flatp t :caching nil))))
389 (setf (slot-value node 'title) "Setting2")
390 (setf (slot-value node 'vars) "var 2")
391 (clsql:update-records-from-instance node)
392 (clsql-sys:update-record-from-slots node '(vars title))
393 (print-fresh-setting)))))
395 "3 Altered title Altered vars"
398 (deftest :oodml/update-records/5
399 (with-dataset *ds-nodes*
400 (flet ((print-fresh-setting ()
401 (let ((node (car (clsql:select 'setting
402 :where [= 3 [slot-value 'setting 'setting-id]]
403 :flatp t :caching nil))))
404 (format nil "~a ~a ~a"
405 (slot-value node 'setting-id)
406 (slot-value node 'title)
407 (slot-value node 'vars)))))
409 (print-fresh-setting)
410 (let ((node (car (clsql:select 'setting
411 :where [= 3 [slot-value 'setting 'setting-id]]
412 :flatp t :caching nil))))
413 (setf (slot-value node 'title) "Altered title")
414 (setf (slot-value node 'vars) "Altered vars")
415 (clsql:update-records-from-instance node)
416 (print-fresh-setting)))))
418 "3 Altered title Altered vars")
420 (deftest :oodml/update-records/5-slots
421 (with-dataset *ds-nodes*
422 (flet ((print-fresh-setting ()
423 (let ((node (car (clsql:select 'setting
424 :where [= 3 [slot-value 'setting 'setting-id]]
425 :flatp t :caching nil))))
426 (format nil "~a ~a ~a"
427 (slot-value node 'setting-id)
428 (slot-value node 'title)
429 (slot-value node 'vars)))))
431 (print-fresh-setting)
432 (let ((node (car (clsql:select 'setting
433 :where [= 3 [slot-value 'setting 'setting-id]]
434 :flatp t :caching nil))))
435 (setf (slot-value node 'title) "Altered title")
436 (setf (slot-value node 'vars) "Altered vars")
437 (clsql-sys:update-record-from-slot node 'title)
438 (clsql-sys:update-record-from-slot node 'vars)
439 (print-fresh-setting))
440 (let ((node (car (clsql:select 'setting
441 :where [= 3 [slot-value 'setting 'setting-id]]
442 :flatp t :caching nil))))
443 (setf (slot-value node 'title) "Setting2")
444 (setf (slot-value node 'vars) "var 2")
445 (clsql-sys:update-record-from-slots node '(title vars))
446 (print-fresh-setting)))))
448 "3 Altered title Altered vars"
451 (deftest :oodml/update-records/6
452 (with-dataset *ds-nodes*
453 (flet ((print-fresh-setting ()
454 (let ((node (car (clsql:select 'setting
455 :where [= 7 [slot-value 'setting 'setting-id]]
456 :flatp t :caching nil))))
457 (format nil "~a ~a ~a"
458 (slot-value node 'setting-id)
459 (slot-value node 'title)
460 (or (slot-value node 'vars) "NIL")))))
462 (print-fresh-setting)
463 (let ((node (car (clsql:select 'setting
464 :where [= 7 [slot-value 'setting 'setting-id]]
465 :flatp t :caching nil))))
466 (setf (slot-value node 'title) "Altered title")
467 (setf (slot-value node 'vars) "Altered vars")
468 (clsql:update-records-from-instance node)
469 (print-fresh-setting))
470 (let ((node (car (clsql:select 'setting
471 :where [= 7 [slot-value 'setting 'setting-id]]
472 :flatp t :caching nil))))
473 (setf (slot-value node 'title) "theme-2")
474 (setf (slot-value node 'vars) nil)
475 (clsql:update-records-from-instance node)
476 (print-fresh-setting)))))
478 "7 Altered title Altered vars"
481 (deftest :oodml/update-records/7
482 (with-dataset *ds-nodes*
483 (flet ((print-fresh-user ()
484 "requery to get what the db has, and print out."
485 (let ((node (car (clsql:select 'user
486 :where [= 5 [slot-value 'user 'user-id]]
487 :flatp t :caching nil))))
488 (format nil "~a ~a ~a"
489 (slot-value node 'user-id)
490 (slot-value node 'title)
491 (slot-value node 'nick)))))
494 (let ((node (car (clsql:select 'user
495 :where [= 5 [slot-value 'user 'user-id]]
496 :flatp t :caching nil))))
497 (setf (slot-value node 'title) "Altered title")
498 (setf (slot-value node 'nick) "Altered nick")
499 (clsql:update-records-from-instance node)
500 (print-fresh-user)))))
501 "5 user-2 second user"
502 "5 Altered title Altered nick")
504 (deftest :oodml/update-records/8
505 (with-dataset *ds-nodes*
506 (flet ((print-fresh-theme ()
507 (let ((node (car (clsql:select 'theme
508 :where [= 6 [slot-value 'theme 'theme-id]]
509 :flatp t :caching nil))))
510 (with-slots (node-id setting-id theme-id title vars doc) node
511 (format nil "~a ~a ~a ~a ~a ~a"
512 node-id setting-id theme-id
513 title (or vars "NIL") doc)))))
516 (let ((node (car (clsql:select 'setting
517 :where [= 6 [slot-value 'setting 'setting-id]]
518 :flatp t :caching nil))))
519 (setf (slot-value node 'title) "Altered title")
520 (setf (slot-value node 'vars) nil)
521 (clsql:update-records-from-instance node)
523 (let ((node (car (clsql:select 'theme
524 :where [= 6 [slot-value 'theme 'theme-id]]
525 :flatp t :caching nil))))
526 (setf (slot-value node 'title) "Altered title again")
527 (setf (slot-value node 'doc) "altered doc")
528 (clsql:update-records-from-instance node)
530 (let ((node (car (clsql:select 'theme
531 :where [= 6 [slot-value 'theme 'theme-id]]
532 :flatp t :caching nil))))
533 (setf (slot-value node 'title) "theme-1")
534 (setf (slot-value node 'vars) "empty")
535 (setf (slot-value node 'doc) "first theme")
536 (clsql:update-records-from-instance node)
537 (print-fresh-theme)))))
538 "6 6 6 theme-1 empty first theme"
539 "6 6 6 Altered title NIL first theme"
540 "6 6 6 Altered title again NIL altered doc"
541 "6 6 6 theme-1 empty first theme")
543 (deftest :oodml/update-records/9
544 (with-dataset *ds-nodes*
545 (flet ((print-fresh-subloc ()
546 (let ((sl (car (clsql:select 'subloc
547 :where [= 10 [slot-value 'subloc 'subloc-id]]
548 :flatp t :caching nil))))
549 (format nil "~a ~a ~a"
550 (slot-value sl 'subloc-id)
551 (slot-value sl 'title)
552 (slot-value sl 'loc)))))
555 (let ((sl (car (clsql:select 'subloc
556 :where [= 10 [slot-value 'subloc 'subloc-id]]
557 :flatp t :caching nil))))
558 (setf (slot-value sl 'title) "Altered subloc title")
559 (setf (slot-value sl 'loc) "Altered loc")
560 (clsql:update-records-from-instance sl)
561 (print-fresh-subloc)))))
562 "10 subloc-1 a subloc"
563 "10 Altered subloc title Altered loc")
565 (deftest :oodml/update-records/9-slots ;like 9, but use slots fns.
566 (with-dataset *ds-nodes*
567 (flet ((print-fresh-subloc ()
568 (let ((sl (car (clsql:select 'subloc
569 :where [= 10 [slot-value 'subloc 'subloc-id]]
570 :flatp t :caching nil))))
571 (format nil "~a ~a ~a"
572 (slot-value sl 'subloc-id)
573 (slot-value sl 'title)
574 (slot-value sl 'loc)))))
577 (let ((sl (car (clsql:select 'subloc
578 :where [= 10 [slot-value 'subloc 'subloc-id]]
579 :flatp t :caching nil))))
580 (setf (slot-value sl 'title) "Altered subloc title")
581 (setf (slot-value sl 'loc) "Altered loc")
582 (clsql:update-record-from-slot sl 'title)
583 (clsql:update-record-from-slot sl 'loc)
584 (print-fresh-subloc))
585 (let ((sl (car (clsql:select 'subloc
586 :where [= 10 [slot-value 'subloc 'subloc-id]]
587 :flatp t :caching nil))))
588 (setf (slot-value sl 'title) "subloc-1")
589 (setf (slot-value sl 'loc) "a subloc")
590 (clsql:update-record-from-slot sl '(title loc))
591 (print-fresh-subloc)))))
592 "10 subloc-1 a subloc"
593 "10 Altered subloc title Altered loc"
594 "10 subloc-1 a subloc")
596 ;; Verify that we can set a float to nil and then read it back
597 ;; (was failing in Postgresql at somepoint)
598 (deftest :oodml/update-records/10
599 (with-dataset *ds-employees*
600 (let ((emp (first (clsql:select 'employee :where [= [emplid] 1] :flatp t))))
601 (setf (height emp) nil)
602 (clsql-sys:update-record-from-slot emp 'height)
604 (clsql:select [height] :from [employee] :where [= [emplid] 1])
606 (setf (height emp) 42.0)
607 (clsql-sys:update-record-from-slot emp 'height)
608 (clsql:select [height] :from [employee] :where [= [emplid] 1]))
610 (setf (height emp) 24.13d0)
611 (clsql-sys:update-record-from-slot emp 'height)
612 (clsql:select [height] :from [employee] :where [= [emplid] 1])))))
618 ;; tests update-instance-from-records
619 (deftest :oodml/update-instance/1
620 (with-dataset *ds-employees*
622 (format nil "~a ~a: ~a"
623 (slot-value employee1 'first-name)
624 (slot-value employee1 'last-name)
625 (slot-value employee1 'email))
627 (clsql:update-records [employee]
628 :av-pairs '(([first-name] "Ivan")
629 ([last-name] "Petrov")
630 ([email] "petrov@soviet.org"))
631 :where [= [emplid] 1])
632 (clsql:update-instance-from-records employee1)
633 (format nil "~a ~a: ~a"
634 (slot-value employee1 'first-name)
635 (slot-value employee1 'last-name)
636 (slot-value employee1 'email)))))
637 "Vladimir Lenin: lenin@soviet.org"
638 "Ivan Petrov: petrov@soviet.org")
640 ;; tests update-slot-from-record
641 (deftest :oodml/update-instance/2
642 (with-dataset *ds-employees*
644 (slot-value employee1 'email)
646 (clsql:update-records [employee]
647 :av-pairs '(([email] "lenin-nospam@soviet.org"))
648 :where [= [emplid] 1])
649 (clsql:update-slot-from-record employee1 'email)
650 (slot-value employee1 'email))))
651 "lenin@soviet.org" "lenin-nospam@soviet.org")
653 ;; tests normalizedp update-instance-from-records
654 (deftest :oodml/update-instance/3
655 (with-dataset *ds-nodes*
657 (with-output-to-string (out)
658 (format out "~a ~a ~a ~a"
659 (slot-value theme2 'theme-id)
660 (slot-value theme2 'title)
661 (or (slot-value theme2 'vars) "NIL")
662 (slot-value theme2 'doc)))
664 (clsql:update-records [node] :av-pairs '(([title] "Altered title"))
665 :where [= [node-id] 7])
666 (clsql:update-records [setting] :av-pairs '(([vars] "Altered vars"))
667 :where [= [setting-id] 7])
668 (clsql:update-records [theme] :av-pairs '(([doc] "Altered doc"))
669 :where [= [theme-id] 7])
670 (clsql:update-instance-from-records theme2)
671 (with-output-to-string (out)
672 (format out "~a ~a ~a ~a"
673 (slot-value theme2 'theme-id)
674 (slot-value theme2 'title)
675 (slot-value theme2 'vars)
676 (slot-value theme2 'doc))))))
677 "7 theme-2 NIL second theme"
678 "7 Altered title Altered vars Altered doc")
680 (deftest :oodml/update-instance/4
681 (with-dataset *ds-nodes*
684 (setf loc2 (car (clsql:select 'location
685 :where [= [node-id] 9]
686 :flatp t :caching nil)))
688 (slot-value loc2 'node-id)
689 (slot-value loc2 'title)))
691 (clsql:update-records [node] :av-pairs '(([title] "Altered title"))
692 :where [= [node-id] 9])
693 (clsql:update-instance-from-records loc2)
695 (slot-value loc2 'node-id)
696 (slot-value loc2 'title)))))
700 (deftest :oodml/update-instance/5
701 (with-dataset *ds-nodes*
703 (format nil "~a ~a ~a"
704 (slot-value subloc2 'subloc-id)
705 (slot-value subloc2 'title)
706 (slot-value subloc2 'loc))
708 (clsql:update-records [node] :av-pairs '(([title] "Altered title"))
709 :where [= [node-id] 11])
710 (clsql:update-records [subloc] :av-pairs '(([loc] "Altered loc"))
711 :where [= [subloc-id] 11])
712 (clsql:update-instance-from-records subloc2)
713 (format nil "~a ~a ~a"
714 (slot-value subloc2 'subloc-id)
715 (slot-value subloc2 'title)
716 (slot-value subloc2 'loc)))))
717 "11 subloc-2 second subloc"
718 "11 Altered title Altered loc")
720 ;; tests update-slot-from-record with normalizedp stuff
721 (deftest :oodml/update-instance/6
722 (with-dataset *ds-nodes*
724 (slot-value theme1 'doc)
725 (slot-value theme1 'vars)
727 (clsql:update-records [theme]
728 :av-pairs '(([doc] "altered doc"))
729 :where [= [theme-id] 6])
730 (clsql:update-slot-from-record theme1 'doc)
731 (slot-value theme1 'doc))
733 (clsql:update-records [setting]
734 :av-pairs '(([vars] "altered vars"))
735 :where [= [setting-id] 6])
736 (clsql:update-slot-from-record theme1 'vars)
737 (slot-value theme1 'vars))))
738 "first theme" "empty"
739 "altered doc" "altered vars")
741 (deftest :oodml/update-instance/7
742 (flet ((print-loc (l)
744 (slot-value l 'node-id) (slot-value l 'title)))
747 (slot-value sl 'node-id) (slot-value sl 'loc))))
748 (with-dataset *ds-nodes*
751 (print-subloc subloc2)
753 (clsql:update-records [node]
754 :av-pairs '(([title] "altered title"))
755 :where [= [node-id] 9])
756 (clsql:update-slot-from-record loc2 'title)
759 (clsql:update-records [subloc]
760 :av-pairs '(([loc] "altered loc"))
761 :where [= [subloc-id] 11])
762 (clsql:update-slot-from-record subloc2 'loc)
763 (print-subloc subloc2)))))
764 "9: location-2" "11: second subloc"
765 "9: altered title" "11: altered loc")
767 (deftest :oodml/do-query/1
768 (with-dataset *ds-employees*
770 (clsql:do-query ((e) [select 'employee :order-by [emplid]])
771 (push (slot-value e 'last-name) result))
773 ("Putin" "Yeltsin" "Gorbachev" "Chernenko" "Andropov" "Brezhnev" "Kruschev"
774 "Trotsky" "Stalin" "Lenin"))
776 (deftest :oodml/do-query/2
777 (with-dataset *ds-employees*
779 (clsql:do-query ((e c) [select 'employee 'company
780 :where [= [slot-value 'employee 'last-name]
782 (push (list (slot-value e 'last-name) (slot-value c 'name))
785 (("Lenin" "Widgets Inc.")))
787 (deftest :oodml/map-query/1
788 (with-dataset *ds-employees*
789 (clsql:map-query 'list #'last-name [select 'employee :order-by [emplid]]))
790 ("Lenin" "Stalin" "Trotsky" "Kruschev" "Brezhnev" "Andropov" "Chernenko"
791 "Gorbachev" "Yeltsin" "Putin"))
793 (deftest :oodml/map-query/2
794 (with-dataset *ds-employees*
795 (clsql:map-query 'list #'(lambda (e c) (list (slot-value e 'last-name)
796 (slot-value c 'name)))
797 [select 'employee 'company :where [= [slot-value 'employee 'last-name]
799 (("Lenin" "Widgets Inc.")))
801 (deftest :oodml/iteration/3
802 (with-dataset *ds-employees*
803 (loop for (e) being the records in
804 [select 'employee :where [< [emplid] 4] :order-by [emplid]]
805 collect (slot-value e 'last-name)))
806 ("Lenin" "Stalin" "Trotsky"))
809 (deftest :oodml/cache/1
810 (with-dataset *ds-employees*
812 (setf (clsql-sys:record-caches *default-database*) nil)
813 (let ((employees (select 'employee)))
814 (every #'(lambda (a b) (eq a b))
815 employees (select 'employee)))))
818 (deftest :oodml/cache/2
819 (with-dataset *ds-employees*
820 (let ((employees (select 'employee)))
821 (equal employees (select 'employee :flatp t))))
824 (deftest :oodml/refresh/1
825 (with-dataset *ds-employees*
826 (let ((addresses (select 'address)))
827 (equal addresses (select 'address :refresh t))))
830 (deftest :oodml/refresh/2
831 (with-dataset *ds-employees*
832 (let* ((addresses (select 'address :order-by [addressid] :flatp t :refresh t))
833 (city (slot-value (car addresses) 'city)))
834 (clsql:update-records [addr]
835 :av-pairs '((city_field "A new city"))
836 :where [= [addressid] (slot-value (car addresses) 'addressid)])
837 (let* ((new-addresses (select 'address :order-by [addressid] :refresh t :flatp t))
838 (new-city (slot-value (car addresses) 'city))
840 (clsql:update-records [addr]
841 :av-pairs `((city_field ,city))
842 :where [= [addressid] (slot-value (car addresses) 'addressid)])
843 (values (equal addresses new-addresses)
846 t "Leningrad" "A new city")
848 (deftest :oodml/refresh/3
849 (with-dataset *ds-employees*
850 (let* ((addresses (select 'address :order-by [addressid] :flatp t)))
852 (equal addresses (select 'address :refresh t :flatp t))
853 (equal addresses (select 'address :flatp t)))))
856 (deftest :oodml/refresh/4
857 (with-dataset *ds-employees*
858 (let* ((addresses (select 'address :order-by [addressid] :flatp t :refresh t))
860 (make-instance 'address :addressid 1000 :city "A new address city")
861 (let ((new-addresses (select 'address :order-by [addressid] :flatp t :refresh t)))
862 (delete-records :from [addr] :where [= [addressid] 1000])
865 (length new-addresses)
866 (eq (first addresses) (first new-addresses))
867 (eq (second addresses) (second new-addresses))))))
871 (deftest :oodml/uoj/1
872 (with-dataset *ds-employees*
874 (let* ((dea-list (select 'deferred-employee-address :caching nil :order-by ["ea_join" aaddressid]
876 (dea-list-copy (copy-seq dea-list))
877 (initially-unbound (every #'(lambda (dea) (not (slot-boundp dea 'address))) dea-list)))
878 (update-objects-joins dea-list)
881 (equal dea-list dea-list-copy)
882 (every #'(lambda (dea) (slot-boundp dea 'address)) dea-list)
883 (every #'(lambda (dea) (typep (slot-value dea 'address) 'address)) dea-list)
884 (mapcar #'(lambda (dea) (slot-value (slot-value dea 'address) 'addressid)) dea-list)))))
887 ;; update-object-joins needs to be fixed for multiple keys
889 (deftest :oodml/uoj/2
891 (clsql:update-objects-joins (list company1))
892 (mapcar #'(lambda (e)
893 (slot-value e 'ecompanyid))
894 (company-employees company1)))
895 (1 1 1 1 1 1 1 1 1 1))
897 (deftest :oodml/big/1
898 (with-dataset *ds-big*
899 (let ((objs (clsql:select 'big :order-by [i] :flatp t)))
904 (rest objs (cdr rest)))
905 ((= i (length objs)) t)
906 (let ((obj (car rest))
908 (unless (and (eql (slot-value obj 'i) index)
909 (eql (slot-value obj 'bi) (truncate max index)))
915 (deftest :oodml/db-auto-sync/1
916 (with-dataset *ds-employees*
919 (make-instance 'employee :emplid 20 :groupid 1
920 :last-name "Ivanovich")
921 (select [last-name] :from [employee] :where [= [emplid] 20]
922 :flatp t :field-names nil))
923 (let ((*db-auto-sync* t))
924 (make-instance 'employee :emplid 20 :groupid 1
925 :last-name "Ivanovich")
926 (prog1 (select [last-name] :from [employee] :flatp t
928 :where [= [emplid] 20])
929 (delete-records :from [employee] :where [= [emplid] 20])))))
932 (deftest :oodml/db-auto-sync/2
933 (with-dataset *ds-employees*
935 (let ((instance (make-instance 'employee :emplid 20 :groupid 1
936 :last-name "Ivanovich")))
937 (setf (slot-value instance 'last-name) "Bulgakov")
938 (select [last-name] :from [employee] :where [= [emplid] 20]
939 :flatp t :field-names nil))
940 (let* ((*db-auto-sync* t)
941 (instance (make-instance 'employee :emplid 20 :groupid 1
942 :last-name "Ivanovich")))
943 (setf (slot-value instance 'last-name) "Bulgakov")
944 (prog1 (select [last-name] :from [employee] :flatp t
946 :where [= [emplid] 20])
947 (delete-records :from [employee] :where [= [emplid] 20])))))
950 (deftest :oodml/db-auto-sync/3
951 (with-dataset *ds-nodes*
954 (make-instance 'theme :title "test-theme" :vars "test-vars"
956 (select [node-id] :from [node] :where [= [title] "test-theme"]
957 :flatp t :field-names nil))
958 (let ((*db-auto-sync* t))
959 (make-instance 'theme :title "test-theme" :vars "test-vars"
961 (prog1 (select [title] :from [node] :where [= [title] "test-theme"]
962 :flatp t :field-names nil)
963 (delete-records :from [node] :where [= [title] "test-theme"])
964 (delete-records :from [setting] :where [= [vars] "test-vars"])
965 (delete-records :from [theme] :where [= [doc] "test-doc"])))))
968 (deftest :oodml/db-auto-sync/4
969 (with-dataset *ds-nodes*
971 (let ((inst (make-instance 'theme
972 :title "test-theme" :vars "test-vars"
974 (*print-circle* nil))
975 (setf (slot-value inst 'title) "alternate-test-theme")
976 (format nil "~a ~a ~a ~a"
977 (or (select [title] :from [node]
978 :where [= [title] "test-theme"]
979 :flatp t :field-names nil) "NIL")
980 (or (select [vars] :from [setting]
981 :where [= [vars] "test-vars"]
982 :flatp t :field-names nil) "NIL")
983 (or (select [doc] :from [theme]
984 :where [= [doc] "test-doc"]
985 :flatp t :field-names nil) "NIL")
986 (or (select [title] :from [node]
987 :where [= [title] "alternate-test-theme"]
988 :flatp t :field-names nil) "NIL")))
989 (let* ((*db-auto-sync* t)
990 (inst (make-instance 'theme
991 :title "test-theme" :vars "test-vars"
993 (setf (slot-value inst 'title) "alternate-test-theme")
995 (format nil "~a ~a ~a ~a"
996 (or (select [title] :from [node]
997 :where [= [title] "test-theme"]
998 :flatp t :field-names nil) "NIL")
999 (or (select [vars] :from [setting]
1000 :where [= [vars] "test-vars"]
1001 :flatp t :field-names nil) "NIL")
1002 (or (select [doc] :from [theme]
1003 :where [= [doc] "test-doc"]
1004 :flatp t :field-names nil) "NIL")
1005 (or (select [title] :from [node]
1006 :where [= [title] "alternate-test-theme"]
1007 :flatp t :field-names nil) "NIL"))
1008 (delete-records :from [node] :where [= [title] "alternate-test-theme"])
1009 (delete-records :from [setting] :where [= [vars] "test-vars"])
1010 (delete-records :from [theme] :where [= [doc] "test-doc"])))))
1012 "NIL (test-vars) (test-doc) (alternate-test-theme)")
1014 (deftest :oodml/setf-slot-value/1
1015 (with-dataset *ds-employees*
1016 (let* ((*db-auto-sync* t)
1017 (instance (make-instance 'employee :emplid 20 :groupid 1)))
1020 (slot-value instance 'first-name) "Mikhail"
1021 (slot-value instance 'last-name) "Bulgakov")
1022 (delete-records :from [employee] :where [= [emplid] 20]))))
1025 (deftest :oodml/float/1
1026 (with-dataset *ds-employees*
1027 (let* ((emp1 (car (select 'employee
1028 :where [= [slot-value 'employee 'emplid]
1032 (height (slot-value emp1 'height)))
1035 (setf (slot-value emp1 'height) 1.0E0)
1036 (clsql:update-record-from-slot emp1 'height)
1037 (= (car (clsql:select [height] :from [employee]
1038 :where [= [emplid] 1]
1042 (setf (slot-value emp1 'height) height)
1043 (clsql:update-record-from-slot emp1 'height))))
1046 (deftest :oodml/float/2
1047 (with-dataset *ds-employees*
1048 (let* ((emp1 (car (select 'employee
1049 :where [= [slot-value 'employee 'emplid]
1053 (height (slot-value emp1 'height)))
1056 (setf (slot-value emp1 'height) 1.0S0)
1057 (clsql:update-record-from-slot emp1 'height)
1058 (= (car (clsql:select [height] :from [employee]
1059 :where [= [emplid] 1]
1063 (setf (slot-value emp1 'height) height)
1064 (clsql:update-record-from-slot emp1 'height))))
1067 (deftest :oodml/float/3
1068 (with-dataset *ds-employees*
1069 (let* ((emp1 (car (select 'employee
1070 :where [= [slot-value 'employee 'emplid]
1074 (height (slot-value emp1 'height)))
1077 (setf (slot-value emp1 'height) 1.0F0)
1078 (clsql:update-record-from-slot emp1 'height)
1079 (= (car (clsql:select [height] :from [employee]
1080 :where [= [emplid] 1]
1084 (setf (slot-value emp1 'height) height)
1085 (clsql:update-record-from-slot emp1 'height))))
1088 (deftest :oodml/float/4
1089 (with-dataset *ds-employees*
1090 (let* ((emp1 (car (select 'employee
1091 :where [= [slot-value 'employee 'emplid]
1095 (height (slot-value emp1 'height)))
1098 (setf (slot-value emp1 'height) 1.0D0)
1099 (clsql:update-record-from-slot emp1 'height)
1100 (= (car (clsql:select [height] :from [employee]
1101 :where [= [emplid] 1]
1105 (setf (slot-value emp1 'height) height)
1106 (clsql:update-record-from-slot emp1 'height))))
1109 (deftest :oodml/float/5
1110 (with-dataset *ds-employees*
1111 (let* ((emp1 (car (select 'employee
1112 :where [= [slot-value 'employee 'emplid]
1116 (height (slot-value emp1 'height)))
1119 (setf (slot-value emp1 'height) 1.0L0)
1120 (clsql:update-record-from-slot emp1 'height)
1121 (= (car (clsql:select [height] :from [employee]
1122 :where [= [emplid] 1]
1126 (setf (slot-value emp1 'height) height)
1127 (clsql:update-record-from-slot emp1 'height))))
1133 #.(clsql:restore-sql-reader-syntax-state)