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)))
221 ;; test retrieval is deferred
222 (deftest :oodm/retrieval/1
223 (with-dataset *ds-employees*
224 (every #'(lambda (e) (not (slot-boundp e 'company)))
225 (select 'employee :flatp t :caching nil)))
228 (deftest :oodm/retrieval/2
229 (with-dataset *ds-employees*
230 (every #'(lambda (e) (not (slot-boundp e 'address)))
231 (select 'deferred-employee-address :flatp t :caching nil)))
234 ;; :retrieval :immediate should be boundp before accessed
235 (deftest :oodm/retrieval/3
236 (with-dataset *ds-employees*
237 (every #'(lambda (ea) (slot-boundp ea 'address))
238 (select 'employee-address :flatp t :caching nil)))
241 (deftest :oodm/retrieval/4
242 (with-dataset *ds-employees*
243 (mapcar #'(lambda (ea) (typep (slot-value ea 'address) 'address))
244 (select 'employee-address :flatp t :caching nil)))
247 (deftest :oodm/retrieval/5
248 (with-dataset *ds-employees*
249 (mapcar #'(lambda (ea) (typep (slot-value ea 'address) 'address))
250 (select 'deferred-employee-address :flatp t :caching nil)))
253 (deftest :oodm/retrieval/6
254 (with-dataset *ds-employees*
255 (every #'(lambda (ea) (slot-boundp (slot-value ea 'address) 'addressid))
256 (select 'employee-address :flatp t :caching nil)))
259 (deftest :oodm/retrieval/7
260 (with-dataset *ds-employees*
261 (every #'(lambda (ea) (slot-boundp (slot-value ea 'address) 'addressid))
262 (select 'deferred-employee-address :flatp t :caching nil)))
265 (deftest :oodm/retrieval/8
266 (with-dataset *ds-employees*
267 (mapcar #'(lambda (ea) (slot-value (slot-value ea 'address) 'street-number))
268 (select 'employee-address :flatp t :order-by [aaddressid] :caching nil)))
271 (deftest :oodm/retrieval/9
272 (with-dataset *ds-employees*
273 (mapcar #'(lambda (ea) (slot-value (slot-value ea 'address) 'street-number))
274 (select 'deferred-employee-address :flatp t :order-by [aaddressid] :caching nil)))
277 ;; tests update-records-from-instance
278 (deftest :oodml/update-records/1
279 (with-dataset *ds-employees*
282 (let ((lenin (car (clsql:select 'employee
283 :where [= 1 [slot-value 'employee 'emplid]]
286 (format nil "~a ~a: ~a"
289 (employee-email lenin))))
291 (setf (slot-value employee1 'first-name) "Dimitriy"
292 (slot-value employee1 'last-name) "Ivanovich"
293 (slot-value employee1 'email) "ivanovich@soviet.org")
294 (clsql:update-records-from-instance employee1)
295 (let ((lenin (car (clsql:select 'employee
296 :where [= 1 [slot-value 'employee 'emplid]]
299 (format nil "~a ~a: ~a"
302 (employee-email lenin))))))
303 "Vladimir Lenin: lenin@soviet.org"
304 "Dimitriy Ivanovich: ivanovich@soviet.org")
306 ;; tests update-record-from-slot
307 (deftest :oodml/update-records/2
308 (with-dataset *ds-employees*
309 ;(start-sql-recording :type :both)
312 (car (clsql:select 'employee
313 :where [= 1 [slot-value 'employee 'emplid]]
317 (setf (slot-value employee1 'email) "lenin-nospam@soviet.org")
318 (clsql:update-record-from-slot employee1 'email)
320 (car (clsql:select 'employee
321 :where [= 1 [slot-value 'employee 'emplid]]
324 "lenin@soviet.org" "lenin-nospam@soviet.org")
326 ;; tests update-record-from-slots
327 (deftest :oodml/update-records/3
328 (with-dataset *ds-employees*
330 (let ((lenin (car (clsql:select 'employee
331 :where [= 1 [slot-value 'employee 'emplid]]
334 (format nil "~a ~a: ~a"
337 (employee-email lenin)))
339 (setf (slot-value employee1 'first-name) "Dimitriy"
340 (slot-value employee1 'last-name) "Ivanovich"
341 (slot-value employee1 'email) "ivanovich@soviet.org")
342 (clsql:update-record-from-slots employee1 '(first-name last-name email))
343 (let ((lenin (car (clsql:select 'employee
344 :where [= 1 [slot-value 'employee 'emplid]]
347 (format nil "~a ~a: ~a"
350 (employee-email lenin))))))
351 "Vladimir Lenin: lenin@soviet.org"
352 "Dimitriy Ivanovich: ivanovich@soviet.org")
354 (deftest :oodml/update-records/4
355 (with-dataset *ds-nodes*
356 (flet ((print-fresh-node ()
357 (let ((base (car (clsql:select 'node
358 :where [= 1 [slot-value 'node 'node-id]]
359 :flatp t :caching nil))))
361 (slot-value base 'node-id)
362 (slot-value base 'title)))))
365 (let ((base (car (clsql:select 'node
366 :where [= 1 [slot-value 'node 'node-id]]
367 :flatp t :caching nil))))
368 (setf (slot-value base 'title) "Altered title")
369 (clsql:update-records-from-instance base)
370 (print-fresh-node)))))
374 (deftest :oodml/update-records/4-slots ;just like 4, but use slots fns.
375 (with-dataset *ds-nodes*
376 (flet ((print-fresh-setting ()
377 (let ((node (car (clsql:select 'setting
378 :where [= 3 [slot-value 'setting 'setting-id]]
379 :flatp t :caching nil))))
380 (format nil "~a ~a ~a"
381 (slot-value node 'setting-id)
382 (slot-value node 'title)
383 (slot-value 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) "Altered title")
390 (setf (slot-value node 'vars) "Altered vars")
391 (clsql-sys:update-record-from-slot node 'title)
392 (clsql-sys:update-record-from-slot node 'vars)
393 (print-fresh-setting))
394 (let ((node (car (clsql:select 'setting
395 :where [= 3 [slot-value 'setting 'setting-id]]
396 :flatp t :caching nil))))
397 (setf (slot-value node 'title) "Setting2")
398 (setf (slot-value node 'vars) "var 2")
399 (clsql:update-records-from-instance node)
400 (clsql-sys:update-record-from-slots node '(vars title))
401 (print-fresh-setting)))))
403 "3 Altered title Altered vars"
406 (deftest :oodml/update-records/5
407 (with-dataset *ds-nodes*
408 (flet ((print-fresh-setting ()
409 (let ((node (car (clsql:select 'setting
410 :where [= 3 [slot-value 'setting 'setting-id]]
411 :flatp t :caching nil))))
412 (format nil "~a ~a ~a"
413 (slot-value node 'setting-id)
414 (slot-value node 'title)
415 (slot-value node 'vars)))))
417 (print-fresh-setting)
418 (let ((node (car (clsql:select 'setting
419 :where [= 3 [slot-value 'setting 'setting-id]]
420 :flatp t :caching nil))))
421 (setf (slot-value node 'title) "Altered title")
422 (setf (slot-value node 'vars) "Altered vars")
423 (clsql:update-records-from-instance node)
424 (print-fresh-setting)))))
426 "3 Altered title Altered vars")
428 (deftest :oodml/update-records/5-slots
429 (with-dataset *ds-nodes*
430 (flet ((print-fresh-setting ()
431 (let ((node (car (clsql:select 'setting
432 :where [= 3 [slot-value 'setting 'setting-id]]
433 :flatp t :caching nil))))
434 (format nil "~a ~a ~a"
435 (slot-value node 'setting-id)
436 (slot-value node 'title)
437 (slot-value 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) "Altered title")
444 (setf (slot-value node 'vars) "Altered vars")
445 (clsql-sys:update-record-from-slot node 'title)
446 (clsql-sys:update-record-from-slot node 'vars)
447 (print-fresh-setting))
448 (let ((node (car (clsql:select 'setting
449 :where [= 3 [slot-value 'setting 'setting-id]]
450 :flatp t :caching nil))))
451 (setf (slot-value node 'title) "Setting2")
452 (setf (slot-value node 'vars) "var 2")
453 (clsql-sys:update-record-from-slots node '(title vars))
454 (print-fresh-setting)))))
456 "3 Altered title Altered vars"
459 (deftest :oodml/update-records/6
460 (with-dataset *ds-nodes*
461 (flet ((print-fresh-setting ()
462 (let ((node (car (clsql:select 'setting
463 :where [= 7 [slot-value 'setting 'setting-id]]
464 :flatp t :caching nil))))
465 (format nil "~a ~a ~a"
466 (slot-value node 'setting-id)
467 (slot-value node 'title)
468 (or (slot-value node 'vars) "NIL")))))
470 (print-fresh-setting)
471 (let ((node (car (clsql:select 'setting
472 :where [= 7 [slot-value 'setting 'setting-id]]
473 :flatp t :caching nil))))
474 (setf (slot-value node 'title) "Altered title")
475 (setf (slot-value node 'vars) "Altered vars")
476 (clsql:update-records-from-instance node)
477 (print-fresh-setting))
478 (let ((node (car (clsql:select 'setting
479 :where [= 7 [slot-value 'setting 'setting-id]]
480 :flatp t :caching nil))))
481 (setf (slot-value node 'title) "theme-2")
482 (setf (slot-value node 'vars) nil)
483 (clsql:update-records-from-instance node)
484 (print-fresh-setting)))))
486 "7 Altered title Altered vars"
489 (deftest :oodml/update-records/7
490 (with-dataset *ds-nodes*
491 (flet ((print-fresh-user ()
492 "requery to get what the db has, and print out."
493 (let ((node (car (clsql:select 'user
494 :where [= 5 [slot-value 'user 'user-id]]
495 :flatp t :caching nil))))
496 (format nil "~a ~a ~a"
497 (slot-value node 'user-id)
498 (slot-value node 'title)
499 (slot-value node 'nick)))))
502 (let ((node (car (clsql:select 'user
503 :where [= 5 [slot-value 'user 'user-id]]
504 :flatp t :caching nil))))
505 (setf (slot-value node 'title) "Altered title")
506 (setf (slot-value node 'nick) "Altered nick")
507 (clsql:update-records-from-instance node)
508 (print-fresh-user)))))
509 "5 user-2 second user"
510 "5 Altered title Altered nick")
512 (deftest :oodml/update-records/8
513 (with-dataset *ds-nodes*
514 (flet ((print-fresh-theme ()
515 (let ((node (car (clsql:select 'theme
516 :where [= 6 [slot-value 'theme 'theme-id]]
517 :flatp t :caching nil))))
518 (with-slots (node-id setting-id theme-id title vars doc) node
519 (format nil "~a ~a ~a ~a ~a ~a"
520 node-id setting-id theme-id
521 title (or vars "NIL") doc)))))
524 (let ((node (car (clsql:select 'setting
525 :where [= 6 [slot-value 'setting 'setting-id]]
526 :flatp t :caching nil))))
527 (setf (slot-value node 'title) "Altered title")
528 (setf (slot-value node 'vars) nil)
529 (clsql:update-records-from-instance node)
531 (let ((node (car (clsql:select 'theme
532 :where [= 6 [slot-value 'theme 'theme-id]]
533 :flatp t :caching nil))))
534 (setf (slot-value node 'title) "Altered title again")
535 (setf (slot-value node 'doc) "altered doc")
536 (clsql:update-records-from-instance node)
538 (let ((node (car (clsql:select 'theme
539 :where [= 6 [slot-value 'theme 'theme-id]]
540 :flatp t :caching nil))))
541 (setf (slot-value node 'title) "theme-1")
542 (setf (slot-value node 'vars) "empty")
543 (setf (slot-value node 'doc) "first theme")
544 (clsql:update-records-from-instance node)
545 (print-fresh-theme)))))
546 "6 6 6 theme-1 empty first theme"
547 "6 6 6 Altered title NIL first theme"
548 "6 6 6 Altered title again NIL altered doc"
549 "6 6 6 theme-1 empty first theme")
551 (deftest :oodml/update-records/9
552 (with-dataset *ds-nodes*
553 (flet ((print-fresh-subloc ()
554 (let ((sl (car (clsql:select 'subloc
555 :where [= 10 [slot-value 'subloc 'subloc-id]]
556 :flatp t :caching nil))))
558 (error "Couldn't find expected sublocation"))
559 (format nil "~a ~a ~a"
560 (slot-value sl 'subloc-id)
561 (slot-value sl 'title)
562 (slot-value sl 'loc)))))
565 (let ((sl (car (clsql:select 'subloc
566 :where [= 10 [slot-value 'subloc 'subloc-id]]
567 :flatp t :caching nil))))
568 (setf (slot-value sl 'title) "Altered subloc title")
569 (setf (slot-value sl 'loc) "Altered loc")
570 (clsql:update-records-from-instance sl)
571 (print-fresh-subloc)))))
572 "10 subloc-1 a subloc"
573 "10 Altered subloc title Altered loc")
575 (deftest :oodml/update-records/9-slots ;like 9, but use slots fns.
576 (with-dataset *ds-nodes*
577 (flet ((print-fresh-subloc ()
578 (let ((sl (car (clsql:select 'subloc
579 :where [= 10 [slot-value 'subloc 'subloc-id]]
580 :flatp t :caching nil))))
582 (error "In psfl: found no sublocation with id = 10"))
583 (format nil "~a ~a ~a"
584 (slot-value sl 'subloc-id)
585 (slot-value sl 'title)
586 (slot-value sl 'loc)))))
589 (let ((sl (car (clsql:select 'subloc
590 :where [= 10 [slot-value 'subloc 'subloc-id]]
591 :flatp t :caching nil))))
593 (error "Select for modification: Found no sublocation with id = 10"))
594 (setf (slot-value sl 'title) "Altered subloc title")
595 (setf (slot-value sl 'loc) "Altered loc")
596 (clsql:update-record-from-slot sl 'title)
597 (clsql:update-record-from-slot sl 'loc)
598 (print-fresh-subloc))
599 (let ((sl (car (clsql:select 'subloc
600 :where [= 10 [slot-value 'subloc 'subloc-id]]
601 :flatp t :caching nil))))
603 (error "Select for next modification: Found no sublocation with id = 10"))
604 (setf (slot-value sl 'title) "subloc-1")
605 (setf (slot-value sl 'loc) "a subloc")
606 (clsql:update-record-from-slots sl '(title loc))
607 (print-fresh-subloc)))))
608 "10 subloc-1 a subloc"
609 "10 Altered subloc title Altered loc"
610 "10 subloc-1 a subloc")
612 ;; Verify that we can set a float to nil and then read it back
613 ;; (was failing in Postgresql at somepoint)
614 (deftest :oodml/update-records/10
615 (with-dataset *ds-employees*
616 (let ((emp (first (clsql:select 'employee :where [= [emplid] 1] :flatp t))))
617 (setf (height emp) nil)
618 (clsql-sys:update-record-from-slot emp 'height)
620 (clsql:select [height] :from [employee] :where [= [emplid] 1])
622 (setf (height emp) 42.0)
623 (clsql-sys:update-record-from-slot emp 'height)
624 (clsql:select [height] :from [employee] :where [= [emplid] 1]))
626 (setf (height emp) 24.13d0)
627 (clsql-sys:update-record-from-slot emp 'height)
628 (clsql:select [height] :from [employee] :where [= [emplid] 1])))))
633 (deftest :oodml/update-records/11
634 (with-dataset *ds-artists*
635 (clsql:update-records-from-instance artist1)
636 (list (name artist1) (artist_id artist1)))
639 (deftest :oodml/update-records/12
640 (with-dataset *ds-artists*
641 (clsql:update-records-from-instance artist1)
642 (list (name artist1) (genre artist1)))
643 ("Mogwai" "Unknown"))
645 ;; tests update-instance-from-records
646 (deftest :oodml/update-instance/1
647 (with-dataset *ds-employees*
649 (format nil "~a ~a: ~a"
650 (slot-value employee1 'first-name)
651 (slot-value employee1 'last-name)
652 (slot-value employee1 'email))
654 (clsql:update-records [employee]
655 :av-pairs '(([first-name] "Ivan")
656 ([last-name] "Petrov")
657 ([email] "petrov@soviet.org"))
658 :where [= [emplid] 1])
659 (clsql:update-instance-from-records employee1)
660 (format nil "~a ~a: ~a"
661 (slot-value employee1 'first-name)
662 (slot-value employee1 'last-name)
663 (slot-value employee1 'email)))))
664 "Vladimir Lenin: lenin@soviet.org"
665 "Ivan Petrov: petrov@soviet.org")
667 ;; tests update-slot-from-record
668 (deftest :oodml/update-instance/2
669 (with-dataset *ds-employees*
671 (slot-value employee1 'email)
673 (clsql:update-records [employee]
674 :av-pairs '(([email] "lenin-nospam@soviet.org"))
675 :where [= [emplid] 1])
676 (clsql:update-slot-from-record employee1 'email)
677 (slot-value employee1 'email))))
678 "lenin@soviet.org" "lenin-nospam@soviet.org")
680 ;; tests normalizedp update-instance-from-records
681 (deftest :oodml/update-instance/3
682 (with-dataset *ds-nodes*
684 (with-output-to-string (out)
685 (format out "~a ~a ~a ~a"
686 (slot-value theme2 'theme-id)
687 (slot-value theme2 'title)
688 (or (slot-value theme2 'vars) "NIL")
689 (slot-value theme2 'doc)))
691 (clsql:update-records [node] :av-pairs '(([title] "Altered title"))
692 :where [= [node-id] 7])
693 (clsql:update-records [setting] :av-pairs '(([vars] "Altered vars"))
694 :where [= [setting-id] 7])
695 (clsql:update-records [theme] :av-pairs '(([doc] "Altered doc"))
696 :where [= [theme-id] 7])
697 (clsql:update-instance-from-records theme2)
698 (with-output-to-string (out)
699 (format out "~a ~a ~a ~a"
700 (slot-value theme2 'theme-id)
701 (slot-value theme2 'title)
702 (slot-value theme2 'vars)
703 (slot-value theme2 'doc))))))
704 "7 theme-2 NIL second theme"
705 "7 Altered title Altered vars Altered doc")
707 (deftest :oodml/update-instance/4
708 (with-dataset *ds-nodes*
711 (setf loc2 (car (clsql:select 'location
712 :where [= [node-id] 9]
713 :flatp t :caching nil)))
715 (slot-value loc2 'node-id)
716 (slot-value loc2 'title)))
718 (clsql:update-records [node] :av-pairs '(([title] "Altered title"))
719 :where [= [node-id] 9])
720 (clsql:update-instance-from-records loc2)
722 (slot-value loc2 'node-id)
723 (slot-value loc2 'title)))))
727 (deftest :oodml/update-instance/5
728 (with-dataset *ds-nodes*
730 (format nil "~a ~a ~a"
731 (slot-value subloc2 'subloc-id)
732 (slot-value subloc2 'title)
733 (slot-value subloc2 'loc))
735 (clsql:update-records [node] :av-pairs '(([title] "Altered title"))
736 :where [= [node-id] 11])
737 (clsql:update-records [subloc] :av-pairs '(([loc] "Altered loc"))
738 :where [= [subloc-id] 11])
739 (clsql:update-instance-from-records subloc2)
740 (format nil "~a ~a ~a"
741 (slot-value subloc2 'subloc-id)
742 (slot-value subloc2 'title)
743 (slot-value subloc2 'loc)))))
744 "11 subloc-2 second subloc"
745 "11 Altered title Altered loc")
747 ;; tests update-slot-from-record with normalizedp stuff
748 (deftest :oodml/update-instance/6
749 (with-dataset *ds-nodes*
751 (slot-value theme1 'doc)
752 (slot-value theme1 'vars)
754 (clsql:update-records [theme]
755 :av-pairs '(([doc] "altered doc"))
756 :where [= [theme-id] 6])
757 (clsql:update-slot-from-record theme1 'doc)
758 (slot-value theme1 'doc))
760 (clsql:update-records [setting]
761 :av-pairs '(([vars] "altered vars"))
762 :where [= [setting-id] 6])
763 (clsql:update-slot-from-record theme1 'vars)
764 (slot-value theme1 'vars))))
765 "first theme" "empty"
766 "altered doc" "altered vars")
768 (deftest :oodml/update-instance/7
769 (flet ((print-loc (l)
771 (slot-value l 'node-id) (slot-value l 'title)))
774 (slot-value sl 'node-id) (slot-value sl 'loc))))
775 (with-dataset *ds-nodes*
778 (print-subloc subloc2)
780 (clsql:update-records [node]
781 :av-pairs '(([title] "altered title"))
782 :where [= [node-id] 9])
783 (clsql:update-slot-from-record loc2 'title)
786 (clsql:update-records [subloc]
787 :av-pairs '(([loc] "altered loc"))
788 :where [= [subloc-id] 11])
789 (clsql:update-slot-from-record subloc2 'loc)
790 (print-subloc subloc2)))))
791 "9: location-2" "11: second subloc"
792 "9: altered title" "11: altered loc")
794 (deftest :oodml/do-query/1
795 (with-dataset *ds-employees*
797 (clsql:do-query ((e) [select 'employee :order-by [emplid]])
798 (push (slot-value e 'last-name) result))
800 ("Putin" "Yeltsin" "Gorbachev" "Chernenko" "Andropov" "Brezhnev" "Kruschev"
801 "Trotsky" "Stalin" "Lenin"))
803 (deftest :oodml/do-query/2
804 (with-dataset *ds-employees*
806 (clsql:do-query ((e c) [select 'employee 'company
807 :where [= [slot-value 'employee 'last-name]
809 (push (list (slot-value e 'last-name) (slot-value c 'name))
812 (("Lenin" "Widgets Inc.")))
814 (deftest :oodml/map-query/1
815 (with-dataset *ds-employees*
816 (clsql:map-query 'list #'last-name [select 'employee :order-by [emplid]]))
817 ("Lenin" "Stalin" "Trotsky" "Kruschev" "Brezhnev" "Andropov" "Chernenko"
818 "Gorbachev" "Yeltsin" "Putin"))
820 (deftest :oodml/map-query/2
821 (with-dataset *ds-employees*
822 (clsql:map-query 'list #'(lambda (e c) (list (slot-value e 'last-name)
823 (slot-value c 'name)))
824 [select 'employee 'company :where [= [slot-value 'employee 'last-name]
826 (("Lenin" "Widgets Inc.")))
828 (deftest :oodml/iteration/3
829 (with-dataset *ds-employees*
830 (loop for (e) being the records in
831 [select 'employee :where [< [emplid] 4] :order-by [emplid]]
832 collect (slot-value e 'last-name)))
833 ("Lenin" "Stalin" "Trotsky"))
836 (deftest :oodml/cache/1
837 (with-dataset *ds-employees*
839 (setf (clsql-sys:record-caches *default-database*) nil)
840 (let ((employees (select 'employee)))
841 (every #'(lambda (a b) (eq a b))
842 employees (select 'employee)))))
845 (deftest :oodml/cache/2
846 (with-dataset *ds-employees*
847 (let ((employees (select 'employee)))
848 (equal employees (select 'employee :flatp t))))
851 (deftest :oodml/refresh/1
852 (with-dataset *ds-employees*
853 (let ((addresses (select 'address)))
854 (equal addresses (select 'address :refresh t))))
857 (deftest :oodml/refresh/2
858 (with-dataset *ds-employees*
859 (let* ((addresses (select 'address :order-by [addressid] :flatp t :refresh t))
860 (city (slot-value (car addresses) 'city)))
861 (clsql:update-records [addr]
862 :av-pairs '((city_field "A new city"))
863 :where [= [addressid] (slot-value (car addresses) 'addressid)])
864 (let* ((new-addresses (select 'address :order-by [addressid] :refresh t :flatp t))
865 (new-city (slot-value (car addresses) 'city))
867 (clsql:update-records [addr]
868 :av-pairs `((city_field ,city))
869 :where [= [addressid] (slot-value (car addresses) 'addressid)])
870 (values (equal addresses new-addresses)
873 t "Leningrad" "A new city")
875 (deftest :oodml/refresh/3
876 (with-dataset *ds-employees*
877 (let* ((addresses (select 'address :order-by [addressid] :flatp t)))
879 (equal addresses (select 'address :refresh t :flatp t))
880 (equal addresses (select 'address :flatp t)))))
883 (deftest :oodml/refresh/4
884 (with-dataset *ds-employees*
885 (let* ((addresses (select 'address :order-by [addressid] :flatp t :refresh t))
887 (make-instance 'address :addressid 1000 :city "A new address city")
888 (let ((new-addresses (select 'address :order-by [addressid] :flatp t :refresh t)))
889 (delete-records :from [addr] :where [= [addressid] 1000])
892 (length new-addresses)
893 (eq (first addresses) (first new-addresses))
894 (eq (second addresses) (second new-addresses))))))
898 (deftest :oodml/uoj/1
899 (with-dataset *ds-employees*
901 (let* ((dea-list (select 'deferred-employee-address :caching nil :order-by ["ea_join" aaddressid]
903 (dea-list-copy (copy-seq dea-list))
904 (initially-unbound (every #'(lambda (dea) (not (slot-boundp dea 'address))) dea-list)))
905 (update-objects-joins dea-list)
908 (equal dea-list dea-list-copy)
909 (every #'(lambda (dea) (slot-boundp dea 'address)) dea-list)
910 (every #'(lambda (dea) (typep (slot-value dea 'address) 'address)) dea-list)
911 (mapcar #'(lambda (dea) (slot-value (slot-value dea 'address) 'addressid)) dea-list)))))
914 ;; update-object-joins needs to be fixed for multiple keys
916 (deftest :oodml/uoj/2
918 (clsql:update-objects-joins (list company1))
919 (mapcar #'(lambda (e)
920 (slot-value e 'ecompanyid))
921 (company-employees company1)))
922 (1 1 1 1 1 1 1 1 1 1))
924 (deftest :oodml/big/1
925 (with-dataset *ds-big*
926 (let ((objs (clsql:select 'big :order-by [i] :flatp t)))
931 (rest objs (cdr rest)))
932 ((= i (length objs)) t)
933 (let ((obj (car rest))
935 (unless (and (eql (slot-value obj 'i) index)
936 (eql (slot-value obj 'bi) (truncate max index)))
942 (deftest :oodml/db-auto-sync/1
943 (with-dataset *ds-employees*
946 (make-instance 'employee :emplid 20 :groupid 1
947 :last-name "Ivanovich")
948 (select [last-name] :from [employee] :where [= [emplid] 20]
949 :flatp t :field-names nil))
950 (let ((*db-auto-sync* t))
951 (make-instance 'employee :emplid 20 :groupid 1
952 :last-name "Ivanovich")
953 (prog1 (select [last-name] :from [employee] :flatp t
955 :where [= [emplid] 20])
956 (delete-records :from [employee] :where [= [emplid] 20])))))
959 (deftest :oodml/db-auto-sync/2
960 (with-dataset *ds-employees*
962 (let ((instance (make-instance 'employee :emplid 20 :groupid 1
963 :last-name "Ivanovich")))
964 (setf (slot-value instance 'last-name) "Bulgakov")
965 (select [last-name] :from [employee] :where [= [emplid] 20]
966 :flatp t :field-names nil))
967 (let* ((*db-auto-sync* t)
968 (instance (make-instance 'employee :emplid 20 :groupid 1
969 :last-name "Ivanovich")))
970 (setf (slot-value instance 'last-name) "Bulgakov")
971 (prog1 (select [last-name] :from [employee] :flatp t
973 :where [= [emplid] 20])
974 (delete-records :from [employee] :where [= [emplid] 20])))))
977 (deftest :oodml/db-auto-sync/3
978 (with-dataset *ds-nodes*
981 (make-instance 'theme :title "test-theme" :vars "test-vars"
983 (select [node-id] :from [node] :where [= [title] "test-theme"]
984 :flatp t :field-names nil))
985 (let ((*db-auto-sync* t))
986 (make-instance 'theme :title "test-theme" :vars "test-vars"
988 (prog1 (select [title] :from [node] :where [= [title] "test-theme"]
989 :flatp t :field-names nil)
990 (delete-records :from [node] :where [= [title] "test-theme"])
991 (delete-records :from [setting] :where [= [vars] "test-vars"])
992 (delete-records :from [theme] :where [= [doc] "test-doc"])))))
995 (deftest :oodml/db-auto-sync/4
996 (with-dataset *ds-nodes*
998 (let ((inst (make-instance 'theme
999 :title "test-theme" :vars "test-vars"
1001 (*print-circle* nil))
1002 (setf (slot-value inst 'title) "alternate-test-theme")
1003 (format nil "~a ~a ~a ~a"
1004 (or (select [title] :from [node]
1005 :where [= [title] "test-theme"]
1006 :flatp t :field-names nil) "NIL")
1007 (or (select [vars] :from [setting]
1008 :where [= [vars] "test-vars"]
1009 :flatp t :field-names nil) "NIL")
1010 (or (select [doc] :from [theme]
1011 :where [= [doc] "test-doc"]
1012 :flatp t :field-names nil) "NIL")
1013 (or (select [title] :from [node]
1014 :where [= [title] "alternate-test-theme"]
1015 :flatp t :field-names nil) "NIL")))
1016 (let* ((*db-auto-sync* t)
1017 (inst (make-instance 'theme
1018 :title "test-theme" :vars "test-vars"
1020 (setf (slot-value inst 'title) "alternate-test-theme")
1022 (format nil "~a ~a ~a ~a"
1023 (or (select [title] :from [node]
1024 :where [= [title] "test-theme"]
1025 :flatp t :field-names nil) "NIL")
1026 (or (select [vars] :from [setting]
1027 :where [= [vars] "test-vars"]
1028 :flatp t :field-names nil) "NIL")
1029 (or (select [doc] :from [theme]
1030 :where [= [doc] "test-doc"]
1031 :flatp t :field-names nil) "NIL")
1032 (or (select [title] :from [node]
1033 :where [= [title] "alternate-test-theme"]
1034 :flatp t :field-names nil) "NIL"))
1035 (delete-records :from [node] :where [= [title] "alternate-test-theme"])
1036 (delete-records :from [setting] :where [= [vars] "test-vars"])
1037 (delete-records :from [theme] :where [= [doc] "test-doc"])))))
1039 "NIL (test-vars) (test-doc) (alternate-test-theme)")
1041 (deftest :oodml/setf-slot-value/1
1042 (with-dataset *ds-employees*
1043 (let* ((*db-auto-sync* t)
1044 (instance (make-instance 'employee :emplid 20 :groupid 1)))
1047 (slot-value instance 'first-name) "Mikhail"
1048 (slot-value instance 'last-name) "Bulgakov")
1049 (delete-records :from [employee] :where [= [emplid] 20]))))
1052 (deftest :oodml/float/1
1053 (with-dataset *ds-employees*
1054 (let* ((emp1 (car (select 'employee
1055 :where [= [slot-value 'employee 'emplid]
1059 (height (slot-value emp1 'height)))
1062 (setf (slot-value emp1 'height) 1.0E0)
1063 (clsql:update-record-from-slot emp1 'height)
1064 (= (car (clsql:select [height] :from [employee]
1065 :where [= [emplid] 1]
1069 (setf (slot-value emp1 'height) height)
1070 (clsql:update-record-from-slot emp1 'height))))
1073 (deftest :oodml/float/2
1074 (with-dataset *ds-employees*
1075 (let* ((emp1 (car (select 'employee
1076 :where [= [slot-value 'employee 'emplid]
1080 (height (slot-value emp1 'height)))
1083 (setf (slot-value emp1 'height) 1.0S0)
1084 (clsql:update-record-from-slot emp1 'height)
1085 (= (car (clsql:select [height] :from [employee]
1086 :where [= [emplid] 1]
1090 (setf (slot-value emp1 'height) height)
1091 (clsql:update-record-from-slot emp1 'height))))
1094 (deftest :oodml/float/3
1095 (with-dataset *ds-employees*
1096 (let* ((emp1 (car (select 'employee
1097 :where [= [slot-value 'employee 'emplid]
1101 (height (slot-value emp1 'height)))
1104 (setf (slot-value emp1 'height) 1.0F0)
1105 (clsql:update-record-from-slot emp1 'height)
1106 (= (car (clsql:select [height] :from [employee]
1107 :where [= [emplid] 1]
1111 (setf (slot-value emp1 'height) height)
1112 (clsql:update-record-from-slot emp1 'height))))
1115 (deftest :oodml/float/4
1116 (with-dataset *ds-employees*
1117 (let* ((emp1 (car (select 'employee
1118 :where [= [slot-value 'employee 'emplid]
1122 (height (slot-value emp1 'height)))
1125 (setf (slot-value emp1 'height) 1.0D0)
1126 (clsql:update-record-from-slot emp1 'height)
1127 (= (car (clsql:select [height] :from [employee]
1128 :where [= [emplid] 1]
1132 (setf (slot-value emp1 'height) height)
1133 (clsql:update-record-from-slot emp1 'height))))
1136 (deftest :oodml/float/5
1137 (with-dataset *ds-employees*
1138 (let* ((emp1 (car (select 'employee
1139 :where [= [slot-value 'employee 'emplid]
1143 (height (slot-value emp1 'height)))
1146 (setf (slot-value emp1 'height) 1.0L0)
1147 (clsql:update-record-from-slot emp1 'height)
1148 (= (car (clsql:select [height] :from [employee]
1149 :where [= [emplid] 1]
1153 (setf (slot-value emp1 'height) height)
1154 (clsql:update-record-from-slot emp1 'height))))
1160 #.(clsql:restore-sql-reader-syntax-state)