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-sys:file-enable-sql-reader-syntax)
20 (defmacro has-sql-value-conversion-error (() &body body)
21 `(let (*debugger-hook*)
24 (clsql-sys::sql-value-conversion-error (c)
31 (deftest :oodml/read-symbol-value/1-into-this-package
32 (clsql-sys::read-sql-value
33 (clsql-sys::database-output-sql-as-type 'symbol 'clsql-tests::foo nil nil)
37 (deftest :oodml/read-symbol-value/2-into-another-pacakge
38 (clsql-sys::read-sql-value
39 (clsql-sys::database-output-sql-as-type 'symbol 'clsql-sys::foo nil nil)
43 (deftest :oodml/read-symbol-value/3-keyword
44 (clsql-sys::read-sql-value
45 (clsql-sys::database-output-sql-as-type 'keyword ':foo nil nil)
49 (deftest :oodml/read-symbol-value/4-keyword-error
50 (has-sql-value-conversion-error ()
51 (clsql-sys::read-sql-value
52 (clsql-sys::database-output-sql-as-type 'keyword 'foo nil nil)
56 (deftest :oodml/read-symbol-value/5-unknown-type-error-1
57 (has-sql-value-conversion-error ()
58 (clsql-sys::read-sql-value
59 (clsql-sys::database-output-sql-as-type 'bloop 'foo nil nil)
63 (deftest :oodml/read-symbol-value/6-unknown-type-error-2
64 (has-sql-value-conversion-error ()
65 (clsql-sys::read-sql-value
66 (clsql-sys::database-output-sql-as-type 'bloop 'foo nil nil)
67 '(or integer float) nil nil))
70 (deftest :oodml/read-symbol-value/read-list
71 (clsql-sys::read-sql-value
72 (clsql-sys::database-output-sql-as-type
73 'list '(("status" "new" "open")) nil nil)
75 (("status" "new" "open")))
77 (deftest :oodml/select/1
78 (with-dataset *ds-employees*
79 (mapcar #'(lambda (e) (slot-value e 'last-name))
80 (clsql:select 'employee :order-by [last-name] :flatp t :caching nil)))
81 ("Andropov" "Brezhnev" "Chernenko" "Gorbachev" "Kruschev" "Lenin" "Putin"
82 "Stalin" "Trotsky" "Yeltsin"))
84 (deftest :oodml/select/2
85 (with-dataset *ds-employees*
86 (mapcar #'(lambda (e) (slot-value e 'name))
87 (clsql:select 'company :flatp t :caching nil)))
90 (deftest :oodml/select/3
91 (with-dataset *ds-employees*
92 (mapcar #'(lambda (e) (slot-value e 'ecompanyid))
93 (clsql:select 'employee
94 :where [and [= [slot-value 'employee 'ecompanyid]
95 [slot-value 'company 'companyid]]
96 [= [slot-value 'company 'name]
100 (1 1 1 1 1 1 1 1 1 1))
102 (deftest :oodml/select/4
103 (with-dataset *ds-employees*
104 (mapcar #'(lambda (e)
105 (concatenate 'string (slot-value e 'first-name)
107 (slot-value e 'last-name)))
108 (clsql:select 'employee :where [= [slot-value 'employee 'first-name]
111 :order-by [last-name]
113 ("Vladimir Lenin" "Vladimir Putin"))
115 (deftest :oodml/select/5
116 (with-dataset *ds-employees*
117 (length (clsql:select 'employee :where [married] :flatp t :caching nil)))
120 (deftest :oodml/select/6
121 (with-dataset *ds-employees*
122 (let ((a (caar (clsql:select 'address :where [= 1 [addressid]] :caching nil))))
124 (slot-value a 'street-number)
125 (slot-value a 'street-name)
127 (slot-value a 'postal-code))))
128 10 "Park Place" "Leningrad" 123)
130 (deftest :oodml/select/7
131 (with-dataset *ds-employees*
132 (let ((a (caar (clsql:select 'address :where [= 2 [addressid]] :caching nil))))
134 (slot-value a 'street-number)
135 (slot-value a 'street-name)
137 (slot-value a 'postal-code))))
140 (deftest :oodml/select/8
141 (with-dataset *ds-employees*
142 (mapcar #'(lambda (e) (slot-value e 'married))
143 (clsql:select 'employee :flatp t :order-by [emplid] :caching nil)))
144 (t t t nil nil nil nil nil nil nil))
146 (deftest :oodml/select/9
147 (with-dataset *ds-employees*
148 (mapcar #'(lambda (pair)
150 (typep (car pair) 'address)
151 (typep (second pair) 'employee-address)
152 (slot-value (car pair) 'addressid)
153 (slot-value (second pair) 'aaddressid)
154 (slot-value (second pair) 'aemplid)))
155 (employee-addresses employee1)))
156 ((t t 1 1 1) (t t 2 2 1)))
158 (deftest :oodml/select/10
159 (with-dataset *ds-employees*
160 (mapcar #'(lambda (pair)
162 (typep (car pair) 'address)
163 (typep (second pair) 'employee-address)
164 (slot-value (car pair) 'addressid)
165 (slot-value (second pair) 'aaddressid)
166 (slot-value (second pair) 'aemplid)))
167 (employee-addresses employee2)))
170 (deftest :oodml/select/11
171 (with-dataset *ds-employees*
172 (values (mapcar #'(lambda (x) (slot-value x 'emplid))
173 (clsql:select 'employee :order-by '(([emplid] :asc))
175 (mapcar #'(lambda (x) (slot-value x 'emplid))
176 (clsql:select 'employee :order-by '(([emplid] :desc))
178 (1 2 3 4 5 6 7 8 9 10)
179 (10 9 8 7 6 5 4 3 2 1))
181 ;; test retrieval of node, derived nodes etc
182 (deftest :oodml/select/12
183 (with-dataset *ds-nodes*
184 (length (clsql:select 'node :where [not [null [node-id]]] :flatp t :caching nil)))
187 (deftest :oodml/select/13
188 (with-dataset *ds-nodes*
189 (let ((a (car (clsql:select 'node :where [= 1 [node-id]] :flatp t :caching nil))))
191 (slot-value a 'node-id)
192 (slot-value a 'title))))
195 (deftest :oodml/select/14
196 (with-dataset *ds-nodes*
197 (length (clsql:select 'setting :where [not [null [setting-id]]] :flatp t :caching nil)))
200 (deftest :oodml/select/15
201 (with-dataset *ds-nodes*
202 (let ((a (car (clsql:select 'setting :where [= 3 [setting-id]] :flatp t :caching nil))))
204 (slot-value a 'node-id)
205 (slot-value a 'setting-id)
206 (slot-value a 'title)
207 (slot-value a 'vars))))
208 3 3 "Setting2" "var 2")
210 (deftest :oodml/select/16
211 (with-dataset *ds-nodes*
212 (length (clsql:select 'user :where [not [null [user-id]]] :flatp t :caching nil)))
215 (deftest :oodml/select/17
216 (with-dataset *ds-nodes*
217 (let ((a (car (clsql:select 'user :where [= 4 [user-id]] :flatp t :caching nil))))
219 (slot-value a 'node-id)
220 (slot-value a 'user-id)
221 (slot-value a 'title)
222 (slot-value a 'nick))))
223 4 4 "user-1" "first user")
225 (deftest :oodml/select/18
226 (with-dataset *ds-nodes*
227 (length (clsql:select 'theme :where [not [null [theme-id]]] :flatp t :caching nil)))
230 (deftest :oodml/select/19
231 (with-dataset *ds-nodes*
232 (let ((a (car (clsql:select 'theme :where [= 6 [theme-id]] :flatp t :caching nil))))
233 (slot-value a 'theme-id)))
236 (deftest :oodml/select/20
237 (with-dataset *ds-nodes*
238 (let ((a (car (clsql:select 'theme :where [= 7 [theme-id]] :flatp t :caching nil))))
240 (slot-value a 'node-id)
241 (slot-value a 'theme-id)
242 (slot-value a 'title)
249 ;; Some tests to check weird subclassed nodes (node without own table, or subclassed of same)
250 (deftest :oodml/select/21
251 (with-dataset *ds-nodes*
252 (let ((a (car (clsql:select 'location :where [= [title] "location-1"] :flatp t :caching nil))))
254 (slot-value a 'node-id)
255 (slot-value a 'title))))
258 (deftest :oodml/select/22
259 (with-dataset *ds-nodes*
260 (let ((a (car (clsql:select 'subloc :where [not [null [subloc-id]]] :flatp t :caching nil))))
262 (slot-value a 'node-id)
263 (slot-value a 'subloc-id)
264 (slot-value a 'title)
265 (slot-value a 'loc))))
266 10 10 "subloc-1" "a subloc")
268 (deftest :oodml/select/23
269 (with-dataset *ds-artists*
270 (length (clsql:select 'artist :flatp t :caching nil)))
275 ;; test retrieval is deferred
276 (deftest :oodm/retrieval/1
277 (with-dataset *ds-employees*
278 (every #'(lambda (e) (not (slot-boundp e 'company)))
279 (select 'employee :flatp t :caching nil)))
282 (deftest :oodm/retrieval/2
283 (with-dataset *ds-employees*
284 (every #'(lambda (e) (not (slot-boundp e 'address)))
285 (select 'deferred-employee-address :flatp t :caching nil)))
288 ;; :retrieval :immediate should be boundp before accessed
289 (deftest :oodm/retrieval/3
290 (with-dataset *ds-employees*
291 (every #'(lambda (ea) (slot-boundp ea 'address))
292 (select 'employee-address :flatp t :caching nil)))
295 (deftest :oodm/retrieval/4
296 (with-dataset *ds-employees*
297 (every #'(lambda (ea) (typep (slot-value ea 'address) 'address))
298 (select 'employee-address :flatp t :caching nil)))
301 (deftest :oodm/retrieval/5
302 (with-dataset *ds-employees*
303 (every #'(lambda (ea) (typep (slot-value ea 'address) 'address))
304 (select 'deferred-employee-address :flatp t :caching nil)))
307 (deftest :oodm/retrieval/6
308 (with-dataset *ds-employees*
309 (every #'(lambda (ea) (slot-boundp (slot-value ea 'address) 'addressid))
310 (select 'employee-address :flatp t :caching nil)))
313 (deftest :oodm/retrieval/7
314 (with-dataset *ds-employees*
315 (every #'(lambda (ea) (slot-boundp (slot-value ea 'address) 'addressid))
316 (select 'deferred-employee-address :flatp t :caching nil)))
319 (deftest :oodm/retrieval/8
320 (with-dataset *ds-employees*
321 (mapcar #'(lambda (ea) (slot-value (slot-value ea 'address) 'street-number))
322 (select 'employee-address :flatp t :order-by [aaddressid] :caching nil)))
323 (10 10 nil nil nil nil))
325 (deftest :oodm/retrieval/9
326 (with-dataset *ds-employees*
327 (mapcar #'(lambda (ea) (slot-value (slot-value ea 'address) 'street-number))
328 (select 'deferred-employee-address :flatp t :order-by [aaddressid] :caching nil)))
329 (10 10 nil nil nil nil))
331 (deftest :oodm/retrieval/10-slot-columns
332 (with-dataset *ds-employees*
334 (select 'employee :flatp t :caching nil
335 :where [<= [emplid] 3]
336 :order-by `((,[emplid] :asc)))))
337 (supplicant :adherent cl-user::novice))
339 ;; tests update-records-from-instance
340 (deftest :oodml/update-records/1
341 (with-dataset *ds-employees*
344 (let ((lenin (car (clsql:select 'employee
345 :where [= 1 [slot-value 'employee 'emplid]]
348 (format nil "~a ~a: ~a"
351 (employee-email lenin))))
353 (setf (slot-value employee1 'first-name) "Dimitriy"
354 (slot-value employee1 'last-name) "Ivanovich"
355 (slot-value employee1 'email) "ivanovich@soviet.org")
356 (clsql:update-records-from-instance employee1)
357 (let ((lenin (car (clsql:select 'employee
358 :where [= 1 [slot-value 'employee 'emplid]]
361 (format nil "~a ~a: ~a"
364 (employee-email lenin))))))
365 "Vladimir Lenin: lenin@soviet.org"
366 "Dimitriy Ivanovich: ivanovich@soviet.org")
368 ;; tests update-record-from-slot
369 (deftest :oodml/update-records/2
370 (with-dataset *ds-employees*
371 ;(start-sql-recording :type :both)
374 (car (clsql:select 'employee
375 :where [= 1 [slot-value 'employee 'emplid]]
379 (setf (slot-value employee1 'email) "lenin-nospam@soviet.org")
380 (clsql:update-record-from-slot employee1 'email)
382 (car (clsql:select 'employee
383 :where [= 1 [slot-value 'employee 'emplid]]
386 "lenin@soviet.org" "lenin-nospam@soviet.org")
388 ;; tests update-record-from-slots
389 (deftest :oodml/update-records/3
390 (with-dataset *ds-employees*
392 (let ((lenin (car (clsql:select 'employee
393 :where [= 1 [slot-value 'employee 'emplid]]
396 (format nil "~a ~a: ~a"
399 (employee-email lenin)))
401 (setf (slot-value employee1 'first-name) "Dimitriy"
402 (slot-value employee1 'last-name) "Ivanovich"
403 (slot-value employee1 'email) "ivanovich@soviet.org")
404 (clsql:update-record-from-slots employee1 '(first-name last-name email))
405 (let ((lenin (car (clsql:select 'employee
406 :where [= 1 [slot-value 'employee 'emplid]]
409 (format nil "~a ~a: ~a"
412 (employee-email lenin))))))
413 "Vladimir Lenin: lenin@soviet.org"
414 "Dimitriy Ivanovich: ivanovich@soviet.org")
416 (deftest :oodml/update-records/4
417 (with-dataset *ds-nodes*
418 (flet ((print-fresh-node ()
419 (let ((base (car (clsql:select 'node
420 :where [= 1 [slot-value 'node 'node-id]]
421 :flatp t :caching nil))))
423 (slot-value base 'node-id)
424 (slot-value base 'title)))))
427 (let ((base (car (clsql:select 'node
428 :where [= 1 [slot-value 'node 'node-id]]
429 :flatp t :caching nil))))
430 (setf (slot-value base 'title) "Altered title")
431 (clsql:update-records-from-instance base)
432 (print-fresh-node)))))
436 (deftest :oodml/update-records/4-slots ;just like 4, but use slots fns.
437 (with-dataset *ds-nodes*
438 (flet ((print-fresh-setting ()
439 (let ((node (car (clsql:select 'setting
440 :where [= 3 [slot-value 'setting 'setting-id]]
441 :flatp t :caching nil))))
442 (format nil "~a ~a ~a"
443 (slot-value node 'setting-id)
444 (slot-value node 'title)
445 (slot-value 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) "Altered title")
452 (setf (slot-value node 'vars) "Altered vars")
453 (clsql-sys:update-record-from-slot node 'title)
454 (clsql-sys:update-record-from-slot node 'vars)
455 (print-fresh-setting))
456 (let ((node (car (clsql:select 'setting
457 :where [= 3 [slot-value 'setting 'setting-id]]
458 :flatp t :caching nil))))
459 (setf (slot-value node 'title) "Setting2")
460 (setf (slot-value node 'vars) "var 2")
461 (clsql:update-records-from-instance node)
462 (clsql-sys:update-record-from-slots node '(vars title))
463 (print-fresh-setting)))))
465 "3 Altered title Altered vars"
468 (deftest :oodml/update-records/5
469 (with-dataset *ds-nodes*
470 (flet ((print-fresh-setting ()
471 (let ((node (car (clsql:select 'setting
472 :where [= 3 [slot-value 'setting 'setting-id]]
473 :flatp t :caching nil))))
474 (format nil "~a ~a ~a"
475 (slot-value node 'setting-id)
476 (slot-value node 'title)
477 (slot-value node 'vars)))))
479 (print-fresh-setting)
480 (let ((node (car (clsql:select 'setting
481 :where [= 3 [slot-value 'setting 'setting-id]]
482 :flatp t :caching nil))))
483 (setf (slot-value node 'title) "Altered title")
484 (setf (slot-value node 'vars) "Altered vars")
485 (clsql:update-records-from-instance node)
486 (print-fresh-setting)))))
488 "3 Altered title Altered vars")
490 (deftest :oodml/update-records/5-slots
491 (with-dataset *ds-nodes*
492 (flet ((print-fresh-setting ()
493 (let ((node (car (clsql:select 'setting
494 :where [= 3 [slot-value 'setting 'setting-id]]
495 :flatp t :caching nil))))
496 (format nil "~a ~a ~a"
497 (slot-value node 'setting-id)
498 (slot-value node 'title)
499 (slot-value node 'vars)))))
501 (print-fresh-setting)
502 (let ((node (car (clsql:select 'setting
503 :where [= 3 [slot-value 'setting 'setting-id]]
504 :flatp t :caching nil))))
505 (setf (slot-value node 'title) "Altered title")
506 (setf (slot-value node 'vars) "Altered vars")
507 (clsql-sys:update-record-from-slot node 'title)
508 (clsql-sys:update-record-from-slot node 'vars)
509 (print-fresh-setting))
510 (let ((node (car (clsql:select 'setting
511 :where [= 3 [slot-value 'setting 'setting-id]]
512 :flatp t :caching nil))))
513 (setf (slot-value node 'title) "Setting2")
514 (setf (slot-value node 'vars) "var 2")
515 (clsql-sys:update-record-from-slots node '(title vars))
516 (print-fresh-setting)))))
518 "3 Altered title Altered vars"
521 (deftest :oodml/update-records/6
522 (with-dataset *ds-nodes*
523 (flet ((print-fresh-setting ()
524 (let ((node (car (clsql:select 'setting
525 :where [= 7 [slot-value 'setting 'setting-id]]
526 :flatp t :caching nil))))
527 (format nil "~a ~a ~a"
528 (slot-value node 'setting-id)
529 (slot-value node 'title)
530 (or (slot-value node 'vars) "NIL")))))
532 (print-fresh-setting)
533 (let ((node (car (clsql:select 'setting
534 :where [= 7 [slot-value 'setting 'setting-id]]
535 :flatp t :caching nil))))
536 (setf (slot-value node 'title) "Altered title")
537 (setf (slot-value node 'vars) "Altered vars")
538 (clsql:update-records-from-instance node)
539 (print-fresh-setting))
540 (let ((node (car (clsql:select 'setting
541 :where [= 7 [slot-value 'setting 'setting-id]]
542 :flatp t :caching nil))))
543 (setf (slot-value node 'title) "theme-2")
544 (setf (slot-value node 'vars) nil)
545 (clsql:update-records-from-instance node)
546 (print-fresh-setting)))))
548 "7 Altered title Altered vars"
551 (deftest :oodml/update-records/7
552 (with-dataset *ds-nodes*
553 (flet ((print-fresh-user ()
554 "requery to get what the db has, and print out."
555 (let ((node (car (clsql:select 'user
556 :where [= 5 [slot-value 'user 'user-id]]
557 :flatp t :caching nil))))
558 (format nil "~a ~a ~a"
559 (slot-value node 'user-id)
560 (slot-value node 'title)
561 (slot-value node 'nick)))))
564 (let ((node (car (clsql:select 'user
565 :where [= 5 [slot-value 'user 'user-id]]
566 :flatp t :caching nil))))
567 (setf (slot-value node 'title) "Altered title")
568 (setf (slot-value node 'nick) "Altered nick")
569 (clsql:update-records-from-instance node)
570 (print-fresh-user)))))
571 "5 user-2 second user"
572 "5 Altered title Altered nick")
574 (deftest :oodml/update-records/8
575 (with-dataset *ds-nodes*
576 (flet ((print-fresh-theme ()
577 (let ((node (car (clsql:select 'theme
578 :where [= 6 [slot-value 'theme 'theme-id]]
579 :flatp t :caching nil))))
580 (with-slots (node-id setting-id theme-id title vars doc) node
581 (format nil "~a ~a ~a ~a ~a ~a"
582 node-id setting-id theme-id
583 title (or vars "NIL") doc)))))
586 (let ((node (car (clsql:select 'setting
587 :where [= 6 [slot-value 'setting 'setting-id]]
588 :flatp t :caching nil))))
589 (setf (slot-value node 'title) "Altered title")
590 (setf (slot-value node 'vars) nil)
591 (clsql:update-records-from-instance node)
593 (let ((node (car (clsql:select 'theme
594 :where [= 6 [slot-value 'theme 'theme-id]]
595 :flatp t :caching nil))))
596 (setf (slot-value node 'title) "Altered title again")
597 (setf (slot-value node 'doc) "altered doc")
598 (clsql:update-records-from-instance node)
600 (let ((node (car (clsql:select 'theme
601 :where [= 6 [slot-value 'theme 'theme-id]]
602 :flatp t :caching nil))))
603 (setf (slot-value node 'title) "theme-1")
604 (setf (slot-value node 'vars) "empty")
605 (setf (slot-value node 'doc) "first theme")
606 (clsql:update-records-from-instance node)
607 (print-fresh-theme)))))
608 "6 6 6 theme-1 empty first theme"
609 "6 6 6 Altered title NIL first theme"
610 "6 6 6 Altered title again NIL altered doc"
611 "6 6 6 theme-1 empty first theme")
613 (deftest :oodml/update-records/9
614 (with-dataset *ds-nodes*
615 (flet ((print-fresh-subloc ()
616 (let ((sl (car (clsql:select 'subloc
617 :where [= 10 [slot-value 'subloc 'subloc-id]]
618 :flatp t :caching nil))))
620 (error "Couldn't find expected sublocation"))
621 (format nil "~a ~a ~a"
622 (slot-value sl 'subloc-id)
623 (slot-value sl 'title)
624 (slot-value sl 'loc)))))
627 (let ((sl (car (clsql:select 'subloc
628 :where [= 10 [slot-value 'subloc 'subloc-id]]
629 :flatp t :caching nil))))
630 (setf (slot-value sl 'title) "Altered subloc title")
631 (setf (slot-value sl 'loc) "Altered loc")
632 (clsql:update-records-from-instance sl)
633 (print-fresh-subloc)))))
634 "10 subloc-1 a subloc"
635 "10 Altered subloc title Altered loc")
637 (deftest :oodml/update-records/9-slots ;like 9, but use slots fns.
638 (with-dataset *ds-nodes*
639 (flet ((print-fresh-subloc ()
640 (let ((sl (car (clsql:select 'subloc
641 :where [= 10 [slot-value 'subloc 'subloc-id]]
642 :flatp t :caching nil))))
644 (error "In psfl: found no sublocation with id = 10"))
645 (format nil "~a ~a ~a"
646 (slot-value sl 'subloc-id)
647 (slot-value sl 'title)
648 (slot-value sl 'loc)))))
651 (let ((sl (car (clsql:select 'subloc
652 :where [= 10 [slot-value 'subloc 'subloc-id]]
653 :flatp t :caching nil))))
655 (error "Select for modification: Found no sublocation with id = 10"))
656 (setf (slot-value sl 'title) "Altered subloc title")
657 (setf (slot-value sl 'loc) "Altered loc")
658 (clsql:update-record-from-slot sl 'title)
659 (clsql:update-record-from-slot sl 'loc)
660 (print-fresh-subloc))
661 (let ((sl (car (clsql:select 'subloc
662 :where [= 10 [slot-value 'subloc 'subloc-id]]
663 :flatp t :caching nil))))
665 (error "Select for next modification: Found no sublocation with id = 10"))
666 (setf (slot-value sl 'title) "subloc-1")
667 (setf (slot-value sl 'loc) "a subloc")
668 (clsql:update-record-from-slots sl '(title loc))
669 (print-fresh-subloc)))))
670 "10 subloc-1 a subloc"
671 "10 Altered subloc title Altered loc"
672 "10 subloc-1 a subloc")
674 ;; Verify that we can set a float to nil and then read it back
675 ;; (was failing in Postgresql at somepoint)
676 (deftest :oodml/update-records/10
677 (with-dataset *ds-employees*
678 (let ((emp (first (clsql:select 'employee :where [= [emplid] 1] :flatp t))))
679 (setf (height emp) nil)
680 (clsql-sys:update-record-from-slot emp 'height)
682 (clsql:select [height] :from [employee] :where [= [emplid] 1])
684 (setf (height emp) 42.0)
685 (clsql-sys:update-record-from-slot emp 'height)
686 (clsql:select [height] :from [employee] :where [= [emplid] 1]))
688 (setf (height emp) 24.13d0)
689 (clsql-sys:update-record-from-slot emp 'height)
690 (clsql:select [height] :from [employee] :where [= [emplid] 1])))))
695 (deftest :oodml/update-records/11
696 (with-dataset *ds-artists*
697 (clsql:update-records-from-instance artist1)
698 (list (name artist1) (artist_id artist1)))
701 (deftest :oodml/update-records/12
702 (with-dataset *ds-artists*
703 (clsql:update-records-from-instance artist1)
704 (list (name artist1) (genre artist1)))
705 ("Mogwai" "Unknown"))
707 ;; tests update-instance-from-records
708 (deftest :oodml/update-instance/1
709 (with-dataset *ds-employees*
711 (format nil "~a ~a: ~a"
712 (slot-value employee1 'first-name)
713 (slot-value employee1 'last-name)
714 (slot-value employee1 'email))
716 (clsql:update-records [employee]
717 :av-pairs '(([first-name] "Ivan")
718 ([last-name] "Petrov")
719 ([email] "petrov@soviet.org"))
720 :where [= [emplid] 1])
721 (clsql:update-instance-from-records employee1)
722 (format nil "~a ~a: ~a"
723 (slot-value employee1 'first-name)
724 (slot-value employee1 'last-name)
725 (slot-value employee1 'email)))))
726 "Vladimir Lenin: lenin@soviet.org"
727 "Ivan Petrov: petrov@soviet.org")
729 ;; tests update-slot-from-record
730 (deftest :oodml/update-instance/2
731 (with-dataset *ds-employees*
733 (slot-value employee1 'email)
735 (clsql:update-records [employee]
736 :av-pairs '(([email] "lenin-nospam@soviet.org"))
737 :where [= [emplid] 1])
738 (clsql:update-slot-from-record employee1 'email)
739 (slot-value employee1 'email))))
740 "lenin@soviet.org" "lenin-nospam@soviet.org")
742 ;; tests normalizedp update-instance-from-records
743 (deftest :oodml/update-instance/3
744 (with-dataset *ds-nodes*
746 (with-output-to-string (out)
747 (format out "~a ~a ~a ~a"
748 (slot-value theme2 'theme-id)
749 (slot-value theme2 'title)
750 (or (slot-value theme2 'vars) "NIL")
751 (slot-value theme2 'doc)))
753 (clsql:update-records [node] :av-pairs '(([title] "Altered title"))
754 :where [= [node-id] 7])
755 (clsql:update-records [setting] :av-pairs '(([vars] "Altered vars"))
756 :where [= [setting-id] 7])
757 (clsql:update-records [theme] :av-pairs '(([doc] "Altered doc"))
758 :where [= [theme-id] 7])
759 (clsql:update-instance-from-records theme2)
760 (with-output-to-string (out)
761 (format out "~a ~a ~a ~a"
762 (slot-value theme2 'theme-id)
763 (slot-value theme2 'title)
764 (slot-value theme2 'vars)
765 (slot-value theme2 'doc))))))
766 "7 theme-2 NIL second theme"
767 "7 Altered title Altered vars Altered doc")
769 (deftest :oodml/update-instance/4
770 (with-dataset *ds-nodes*
773 (setf loc2 (car (clsql:select 'location
774 :where [= [node-id] 9]
775 :flatp t :caching nil)))
777 (slot-value loc2 'node-id)
778 (slot-value loc2 'title)))
780 (clsql:update-records [node] :av-pairs '(([title] "Altered title"))
781 :where [= [node-id] 9])
782 (clsql:update-instance-from-records loc2)
784 (slot-value loc2 'node-id)
785 (slot-value loc2 'title)))))
789 (deftest :oodml/update-instance/5
790 (with-dataset *ds-nodes*
792 (format nil "~a ~a ~a"
793 (slot-value subloc2 'subloc-id)
794 (slot-value subloc2 'title)
795 (slot-value subloc2 'loc))
797 (clsql:update-records [node] :av-pairs '(([title] "Altered title"))
798 :where [= [node-id] 11])
799 (clsql:update-records [subloc] :av-pairs '(([loc] "Altered loc"))
800 :where [= [subloc-id] 11])
801 (clsql:update-instance-from-records subloc2)
802 (format nil "~a ~a ~a"
803 (slot-value subloc2 'subloc-id)
804 (slot-value subloc2 'title)
805 (slot-value subloc2 'loc)))))
806 "11 subloc-2 second subloc"
807 "11 Altered title Altered loc")
809 ;; tests update-slot-from-record with normalizedp stuff
810 (deftest :oodml/update-instance/6
811 (with-dataset *ds-nodes*
813 (slot-value theme1 'doc)
814 (slot-value theme1 'vars)
816 (clsql:update-records [theme]
817 :av-pairs '(([doc] "altered doc"))
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] "altered vars"))
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")
830 (deftest :oodml/update-instance/7
831 (flet ((print-loc (l)
833 (slot-value l 'node-id) (slot-value l 'title)))
836 (slot-value sl 'node-id) (slot-value sl 'loc))))
837 (with-dataset *ds-nodes*
840 (print-subloc subloc2)
842 (clsql:update-records [node]
843 :av-pairs '(([title] "altered title"))
844 :where [= [node-id] (node-id loc2)])
845 (clsql:update-slot-from-record loc2 'title)
848 (clsql:update-records [subloc]
849 :av-pairs '(([loc] "altered loc"))
850 :where [= [subloc-id] (subloc-id subloc2)])
851 (clsql:update-slot-from-record subloc2 'loc)
852 (print-subloc subloc2)))))
853 "9: location-2" "11: second subloc"
854 "9: altered title" "11: altered loc")
856 (deftest :oodml/do-query/1
857 (with-dataset *ds-employees*
859 (clsql:do-query ((e) [select 'employee :order-by [emplid]])
860 (push (slot-value e 'last-name) result))
862 ("Putin" "Yeltsin" "Gorbachev" "Chernenko" "Andropov" "Brezhnev" "Kruschev"
863 "Trotsky" "Stalin" "Lenin"))
865 (deftest :oodml/do-query/2
866 (with-dataset *ds-employees*
868 (clsql:do-query ((e c) [select 'employee 'company
869 :where [= [slot-value 'employee 'last-name]
871 (push (list (slot-value e 'last-name) (slot-value c 'name))
874 (("Lenin" "Widgets Inc.")))
876 (deftest :oodml/map-query/1
877 (with-dataset *ds-employees*
878 (clsql:map-query 'list #'last-name [select 'employee :order-by [emplid]]))
879 ("Lenin" "Stalin" "Trotsky" "Kruschev" "Brezhnev" "Andropov" "Chernenko"
880 "Gorbachev" "Yeltsin" "Putin"))
882 (deftest :oodml/map-query/2
883 (with-dataset *ds-employees*
884 (clsql:map-query 'list #'(lambda (e c) (list (slot-value e 'last-name)
885 (slot-value c 'name)))
886 [select 'employee 'company :where [= [slot-value 'employee 'last-name]
888 (("Lenin" "Widgets Inc.")))
890 (deftest :oodml/iteration/3
891 (with-dataset *ds-employees*
892 (loop for (e) being the records in
893 [select 'employee :where [< [emplid] 4] :order-by [emplid]]
894 collect (slot-value e 'last-name)))
895 ("Lenin" "Stalin" "Trotsky"))
898 (deftest :oodml/cache/1
899 (with-dataset *ds-employees*
900 (let ((*default-caching* t))
901 (setf (clsql-sys:record-caches *default-database*) nil)
902 (let ((employees (select 'employee)))
903 (every #'(lambda (a b) (eq a b))
904 employees (select 'employee)))))
907 (deftest :oodml/cache/2
908 (with-dataset *ds-employees*
909 (let* ((*default-caching* t)
910 (employees (select 'employee)))
911 (equal employees (select 'employee :flatp t))))
914 (deftest :oodml/refresh/1
915 (with-dataset *ds-employees*
916 (let* ((clsql-sys:*default-caching* t)
917 (addresses (select 'address)))
918 (equal addresses (select 'address :refresh t))))
921 (deftest :oodml/refresh/2
922 (with-dataset *ds-employees*
923 (let* ((clsql-sys:*default-caching* t)
924 (addresses (select 'address :order-by [addressid] :flatp t :refresh t))
925 (city (slot-value (car addresses) 'city)))
926 (clsql:update-records [addr]
927 :av-pairs '((city_field "A new city"))
928 :where [= [addressid] (slot-value (car addresses) 'addressid)])
929 (let* ((new-addresses (select 'address :order-by [addressid] :refresh t :flatp t))
930 (new-city (slot-value (car addresses) 'city))
932 (clsql:update-records [addr]
933 :av-pairs `((city_field ,city))
934 :where [= [addressid] (slot-value (car addresses) 'addressid)])
935 (values (equal addresses new-addresses)
938 t "Leningrad" "A new city")
940 (deftest :oodml/refresh/3
941 (with-dataset *ds-employees*
942 (let* ((clsql-sys:*default-caching* t)
943 (addresses (select 'address :order-by [addressid] :flatp t)))
945 (equal addresses (select 'address :refresh t :flatp t))
946 (equal addresses (select 'address :flatp t)))))
949 (deftest :oodml/refresh/4
950 (with-dataset *ds-employees*
951 (let* ((clsql-sys:*default-caching* t)
952 (addresses (select 'address :order-by [addressid] :flatp t :refresh t))
954 (make-instance 'address :addressid 1000 :city "A new address city")
955 (let ((new-addresses (select 'address :order-by [addressid] :flatp t :refresh t)))
958 (length new-addresses)
959 (eq (first addresses) (first new-addresses))
960 (eq (second addresses) (second new-addresses))))))
964 (deftest :oodml/uoj/full-set
965 (with-dataset *ds-employees*
967 (let* ((dea-list (select 'deferred-employee-address
968 :caching nil :order-by ["ea_join" aaddressid]
970 (dea-list-copy (copy-seq dea-list))
971 (initially-unbound (every #'(lambda (dea) (not (slot-boundp dea 'address))) dea-list)))
972 (update-objects-joins dea-list :slots 'address :max-len nil)
975 (equal dea-list dea-list-copy)
976 (every #'(lambda (dea) (slot-boundp dea 'address)) dea-list)
977 (every #'(lambda (dea) (typep (slot-value dea 'address) 'address)) dea-list)
978 (mapcar #'(lambda (dea) (slot-value (slot-value dea 'address) 'addressid)) dea-list)))))
979 t t t t (1 1 2 2 2 3))
981 (deftest :oodml/uoj/batched
982 (with-dataset *ds-employees*
984 (let* ((dea-list (select 'deferred-employee-address
985 :caching nil :order-by ["ea_join" aaddressid]
987 (dea-list-copy (copy-seq dea-list))
988 (initially-unbound (every #'(lambda (dea) (not (slot-boundp dea 'address))) dea-list)))
989 (update-objects-joins dea-list :slots 'address :max-len 2)
992 (equal dea-list dea-list-copy)
993 (every #'(lambda (dea) (slot-boundp dea 'address)) dea-list)
994 (every #'(lambda (dea) (typep (slot-value dea 'address) 'address)) dea-list)
995 (mapcar #'(lambda (dea) (slot-value (slot-value dea 'address) 'addressid)) dea-list)))))
996 t t t t (1 1 2 2 2 3))
998 ;; update-object-joins needs to be fixed for multiple keys
1000 (deftest :oodml/uoj/multi-key
1002 (clsql:update-objects-joins (list company1))
1003 (mapcar #'(lambda (e)
1004 (slot-value e 'ecompanyid))
1005 (company-employees company1)))
1006 (1 1 1 1 1 1 1 1 1 1))
1008 (deftest :oodml/big/1
1009 (with-dataset *ds-big*
1010 (let ((objs (clsql:select 'big :order-by [i] :flatp t)))
1015 (rest objs (cdr rest)))
1016 ((= i (length objs)) t)
1017 (let ((obj (car rest))
1019 (unless (and (eql (slot-value obj 'i) index)
1020 (eql (slot-value obj 'bi) (truncate max index)))
1026 (deftest :oodml/db-auto-sync/1
1027 (with-dataset *ds-employees*
1030 (make-instance 'employee :emplid 20 :groupid 1
1031 :last-name "Ivanovich")
1032 (select [last-name] :from [employee] :where [= [emplid] 20]
1033 :flatp t :field-names nil))
1034 (let ((*db-auto-sync* t))
1035 (make-instance 'employee :emplid 20 :groupid 1
1036 :last-name "Ivanovich")
1037 (prog1 (select [last-name] :from [employee] :flatp t
1039 :where [= [emplid] 20])
1040 (delete-records :from [employee] :where [= [emplid] 20])))))
1043 (deftest :oodml/db-auto-sync/2
1044 (with-dataset *ds-employees*
1046 (let ((instance (make-instance 'employee :emplid 20 :groupid 1
1047 :last-name "Ivanovich")))
1048 (setf (slot-value instance 'last-name) "Bulgakov")
1049 (select [last-name] :from [employee] :where [= [emplid] 20]
1050 :flatp t :field-names nil))
1051 (let* ((*db-auto-sync* t)
1052 (instance (make-instance 'employee :emplid 20 :groupid 1
1053 :last-name "Ivanovich")))
1054 (setf (slot-value instance 'last-name) "Bulgakov")
1055 (prog1 (select [last-name] :from [employee] :flatp t
1057 :where [= [emplid] 20])
1058 (delete-records :from [employee] :where [= [emplid] 20])))))
1061 (deftest :oodml/db-auto-sync/3
1062 (with-dataset *ds-nodes*
1065 (make-instance 'theme :title "test-theme" :vars "test-vars"
1067 (select [node-id] :from [node] :where [= [title] "test-theme"]
1068 :flatp t :field-names nil))
1069 (let ((*db-auto-sync* t))
1070 (make-instance 'theme :title "test-theme" :vars "test-vars"
1072 (prog1 (select [title] :from [node] :where [= [title] "test-theme"]
1073 :flatp t :field-names nil)
1074 (delete-records :from [node] :where [= [title] "test-theme"])
1075 (delete-records :from [setting] :where [= [vars] "test-vars"])
1076 (delete-records :from [theme] :where [= [doc] "test-doc"])))))
1079 (deftest :oodml/db-auto-sync/4
1080 (with-dataset *ds-nodes*
1082 (let ((inst (make-instance 'theme
1083 :title "test-theme" :vars "test-vars"
1085 (*print-circle* nil))
1086 (setf (slot-value inst 'title) "alternate-test-theme")
1087 (format nil "~a ~a ~a ~a"
1088 (or (select [title] :from [node]
1089 :where [= [title] "test-theme"]
1090 :flatp t :field-names nil) "NIL")
1091 (or (select [vars] :from [setting]
1092 :where [= [vars] "test-vars"]
1093 :flatp t :field-names nil) "NIL")
1094 (or (select [doc] :from [theme]
1095 :where [= [doc] "test-doc"]
1096 :flatp t :field-names nil) "NIL")
1097 (or (select [title] :from [node]
1098 :where [= [title] "alternate-test-theme"]
1099 :flatp t :field-names nil) "NIL")))
1100 (let* ((*db-auto-sync* t)
1101 (inst (make-instance 'theme
1102 :title "test-theme" :vars "test-vars"
1104 (setf (slot-value inst 'title) "alternate-test-theme")
1106 (format nil "~a ~a ~a ~a"
1107 (or (select [title] :from [node]
1108 :where [= [title] "test-theme"]
1109 :flatp t :field-names nil) "NIL")
1110 (or (select [vars] :from [setting]
1111 :where [= [vars] "test-vars"]
1112 :flatp t :field-names nil) "NIL")
1113 (or (select [doc] :from [theme]
1114 :where [= [doc] "test-doc"]
1115 :flatp t :field-names nil) "NIL")
1116 (or (select [title] :from [node]
1117 :where [= [title] "alternate-test-theme"]
1118 :flatp t :field-names nil) "NIL"))
1119 (delete-records :from [node] :where [= [title] "alternate-test-theme"])
1120 (delete-records :from [setting] :where [= [vars] "test-vars"])
1121 (delete-records :from [theme] :where [= [doc] "test-doc"])))))
1123 "NIL (test-vars) (test-doc) (alternate-test-theme)")
1125 (deftest :oodml/setf-slot-value/1
1126 (with-dataset *ds-employees*
1127 (let* ((*db-auto-sync* t)
1128 (instance (make-instance 'employee :emplid 20 :groupid 1)))
1131 (slot-value instance 'first-name) "Mikhail"
1132 (slot-value instance 'last-name) "Bulgakov")
1133 (delete-records :from [employee] :where [= [emplid] 20]))))
1136 (deftest :oodml/float/1
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.0E0)
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))))
1157 (deftest :oodml/float/2
1158 (with-dataset *ds-employees*
1159 (let* ((emp1 (car (select 'employee
1160 :where [= [slot-value 'employee 'emplid]
1164 (height (slot-value emp1 'height)))
1167 (setf (slot-value emp1 'height) 1.0S0)
1168 (clsql:update-record-from-slot emp1 'height)
1169 (= (car (clsql:select [height] :from [employee]
1170 :where [= [emplid] 1]
1174 (setf (slot-value emp1 'height) height)
1175 (clsql:update-record-from-slot emp1 'height))))
1178 (deftest :oodml/float/3
1179 (with-dataset *ds-employees*
1180 (let* ((emp1 (car (select 'employee
1181 :where [= [slot-value 'employee 'emplid]
1185 (height (slot-value emp1 'height)))
1188 (setf (slot-value emp1 'height) 1.0F0)
1189 (clsql:update-record-from-slot emp1 'height)
1190 (= (car (clsql:select [height] :from [employee]
1191 :where [= [emplid] 1]
1195 (setf (slot-value emp1 'height) height)
1196 (clsql:update-record-from-slot emp1 'height))))
1199 (deftest :oodml/float/4
1200 (with-dataset *ds-employees*
1201 (let* ((emp1 (car (select 'employee
1202 :where [= [slot-value 'employee 'emplid]
1206 (height (slot-value emp1 'height)))
1209 (setf (slot-value emp1 'height) 1.0D0)
1210 (clsql:update-record-from-slot emp1 'height)
1211 (= (car (clsql:select [height] :from [employee]
1212 :where [= [emplid] 1]
1216 (setf (slot-value emp1 'height) height)
1217 (clsql:update-record-from-slot emp1 'height))))
1220 (deftest :oodml/float/5
1221 (with-dataset *ds-employees*
1222 (let* ((emp1 (car (select 'employee
1223 :where [= [slot-value 'employee 'emplid]
1227 (height (slot-value emp1 'height)))
1230 (setf (slot-value emp1 'height) 1.0L0)
1231 (clsql:update-record-from-slot emp1 'height)
1232 (= (car (clsql:select [height] :from [employee]
1233 :where [= [emplid] 1]
1237 (setf (slot-value emp1 'height) height)
1238 (clsql:update-record-from-slot emp1 'height))))