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)
24 (deftest :oodml/read-symbol-value/1-into-this-package
25 (clsql-sys::read-sql-value
26 (clsql-sys::database-output-sql-as-type 'symbol 'clsql-tests::foo nil nil)
30 (deftest :oodml/read-symbol-value/2-into-another-pacakge
31 (clsql-sys::read-sql-value
32 (clsql-sys::database-output-sql-as-type 'symbol 'clsql-sys::foo nil nil)
36 (deftest :oodml/read-symbol-value/3-keyword
37 (clsql-sys::read-sql-value
38 (clsql-sys::database-output-sql-as-type 'keyword ':foo nil nil)
42 (deftest :oodml/read-symbol-value/4-keyword-error
44 (clsql-sys::read-sql-value
45 (clsql-sys::database-output-sql-as-type 'keyword 'foo nil nil)
47 (clsql-sys::sql-value-conversion-error (c) (declare (ignore c))
51 (deftest :oodml/select/1
52 (with-dataset *ds-employees*
53 (mapcar #'(lambda (e) (slot-value e 'last-name))
54 (clsql:select 'employee :order-by [last-name] :flatp t :caching nil)))
55 ("Andropov" "Brezhnev" "Chernenko" "Gorbachev" "Kruschev" "Lenin" "Putin"
56 "Stalin" "Trotsky" "Yeltsin"))
58 (deftest :oodml/select/2
59 (with-dataset *ds-employees*
60 (mapcar #'(lambda (e) (slot-value e 'name))
61 (clsql:select 'company :flatp t :caching nil)))
64 (deftest :oodml/select/3
65 (with-dataset *ds-employees*
66 (mapcar #'(lambda (e) (slot-value e 'ecompanyid))
67 (clsql:select 'employee
68 :where [and [= [slot-value 'employee 'ecompanyid]
69 [slot-value 'company 'companyid]]
70 [= [slot-value 'company 'name]
74 (1 1 1 1 1 1 1 1 1 1))
76 (deftest :oodml/select/4
77 (with-dataset *ds-employees*
79 (concatenate 'string (slot-value e 'first-name)
81 (slot-value e 'last-name)))
82 (clsql:select 'employee :where [= [slot-value 'employee 'first-name]
87 ("Vladimir Lenin" "Vladimir Putin"))
89 (deftest :oodml/select/5
90 (with-dataset *ds-employees*
91 (length (clsql:select 'employee :where [married] :flatp t :caching nil)))
94 (deftest :oodml/select/6
95 (with-dataset *ds-employees*
96 (let ((a (caar (clsql:select 'address :where [= 1 [addressid]] :caching nil))))
98 (slot-value a 'street-number)
99 (slot-value a 'street-name)
101 (slot-value a 'postal-code))))
102 10 "Park Place" "Leningrad" 123)
104 (deftest :oodml/select/7
105 (with-dataset *ds-employees*
106 (let ((a (caar (clsql:select 'address :where [= 2 [addressid]] :caching nil))))
108 (slot-value a 'street-number)
109 (slot-value a 'street-name)
111 (slot-value a 'postal-code))))
114 (deftest :oodml/select/8
115 (with-dataset *ds-employees*
116 (mapcar #'(lambda (e) (slot-value e 'married))
117 (clsql:select 'employee :flatp t :order-by [emplid] :caching nil)))
118 (t t t nil nil nil nil nil nil nil))
120 (deftest :oodml/select/9
121 (with-dataset *ds-employees*
122 (mapcar #'(lambda (pair)
124 (typep (car pair) 'address)
125 (typep (second pair) 'employee-address)
126 (slot-value (car pair) 'addressid)
127 (slot-value (second pair) 'aaddressid)
128 (slot-value (second pair) 'aemplid)))
129 (employee-addresses employee1)))
130 ((t t 1 1 1) (t t 2 2 1)))
132 (deftest :oodml/select/10
133 (with-dataset *ds-employees*
134 (mapcar #'(lambda (pair)
136 (typep (car pair) 'address)
137 (typep (second pair) 'employee-address)
138 (slot-value (car pair) 'addressid)
139 (slot-value (second pair) 'aaddressid)
140 (slot-value (second pair) 'aemplid)))
141 (employee-addresses employee2)))
144 (deftest :oodml/select/11
145 (with-dataset *ds-employees*
146 (values (mapcar #'(lambda (x) (slot-value x 'emplid))
147 (clsql:select 'employee :order-by '(([emplid] :asc))
149 (mapcar #'(lambda (x) (slot-value x 'emplid))
150 (clsql:select 'employee :order-by '(([emplid] :desc))
152 (1 2 3 4 5 6 7 8 9 10)
153 (10 9 8 7 6 5 4 3 2 1))
155 ;; test retrieval of node, derived nodes etc
156 (deftest :oodml/select/12
157 (with-dataset *ds-nodes*
158 (length (clsql:select 'node :where [not [null [node-id]]] :flatp t :caching nil)))
161 (deftest :oodml/select/13
162 (with-dataset *ds-nodes*
163 (let ((a (car (clsql:select 'node :where [= 1 [node-id]] :flatp t :caching nil))))
165 (slot-value a 'node-id)
166 (slot-value a 'title))))
169 (deftest :oodml/select/14
170 (with-dataset *ds-nodes*
171 (length (clsql:select 'setting :where [not [null [setting-id]]] :flatp t :caching nil)))
174 (deftest :oodml/select/15
175 (with-dataset *ds-nodes*
176 (let ((a (car (clsql:select 'setting :where [= 3 [setting-id]] :flatp t :caching nil))))
178 (slot-value a 'node-id)
179 (slot-value a 'setting-id)
180 (slot-value a 'title)
181 (slot-value a 'vars))))
182 3 3 "Setting2" "var 2")
184 (deftest :oodml/select/16
185 (with-dataset *ds-nodes*
186 (length (clsql:select 'user :where [not [null [user-id]]] :flatp t :caching nil)))
189 (deftest :oodml/select/17
190 (with-dataset *ds-nodes*
191 (let ((a (car (clsql:select 'user :where [= 4 [user-id]] :flatp t :caching nil))))
193 (slot-value a 'node-id)
194 (slot-value a 'user-id)
195 (slot-value a 'title)
196 (slot-value a 'nick))))
197 4 4 "user-1" "first user")
199 (deftest :oodml/select/18
200 (with-dataset *ds-nodes*
201 (length (clsql:select 'theme :where [not [null [theme-id]]] :flatp t :caching nil)))
204 (deftest :oodml/select/19
205 (with-dataset *ds-nodes*
206 (let ((a (car (clsql:select 'theme :where [= 6 [theme-id]] :flatp t :caching nil))))
207 (slot-value a 'theme-id)))
210 (deftest :oodml/select/20
211 (with-dataset *ds-nodes*
212 (let ((a (car (clsql:select 'theme :where [= 7 [theme-id]] :flatp t :caching nil))))
214 (slot-value a 'node-id)
215 (slot-value a 'theme-id)
216 (slot-value a 'title)
223 ;; Some tests to check weird subclassed nodes (node without own table, or subclassed of same)
224 (deftest :oodml/select/21
225 (with-dataset *ds-nodes*
226 (let ((a (car (clsql:select 'location :where [= [title] "location-1"] :flatp t :caching nil))))
228 (slot-value a 'node-id)
229 (slot-value a 'title))))
232 (deftest :oodml/select/22
233 (with-dataset *ds-nodes*
234 (let ((a (car (clsql:select 'subloc :where [not [null [subloc-id]]] :flatp t :caching nil))))
236 (slot-value a 'node-id)
237 (slot-value a 'subloc-id)
238 (slot-value a 'title)
239 (slot-value a 'loc))))
240 10 10 "subloc-1" "a subloc")
242 (deftest :oodml/select/23
243 (with-dataset *ds-artists*
244 (length (clsql:select 'artist :flatp t :caching nil)))
249 ;; test retrieval is deferred
250 (deftest :oodm/retrieval/1
251 (with-dataset *ds-employees*
252 (every #'(lambda (e) (not (slot-boundp e 'company)))
253 (select 'employee :flatp t :caching nil)))
256 (deftest :oodm/retrieval/2
257 (with-dataset *ds-employees*
258 (every #'(lambda (e) (not (slot-boundp e 'address)))
259 (select 'deferred-employee-address :flatp t :caching nil)))
262 ;; :retrieval :immediate should be boundp before accessed
263 (deftest :oodm/retrieval/3
264 (with-dataset *ds-employees*
265 (every #'(lambda (ea) (slot-boundp ea 'address))
266 (select 'employee-address :flatp t :caching nil)))
269 (deftest :oodm/retrieval/4
270 (with-dataset *ds-employees*
271 (every #'(lambda (ea) (typep (slot-value ea 'address) 'address))
272 (select 'employee-address :flatp t :caching nil)))
275 (deftest :oodm/retrieval/5
276 (with-dataset *ds-employees*
277 (every #'(lambda (ea) (typep (slot-value ea 'address) 'address))
278 (select 'deferred-employee-address :flatp t :caching nil)))
281 (deftest :oodm/retrieval/6
282 (with-dataset *ds-employees*
283 (every #'(lambda (ea) (slot-boundp (slot-value ea 'address) 'addressid))
284 (select 'employee-address :flatp t :caching nil)))
287 (deftest :oodm/retrieval/7
288 (with-dataset *ds-employees*
289 (every #'(lambda (ea) (slot-boundp (slot-value ea 'address) 'addressid))
290 (select 'deferred-employee-address :flatp t :caching nil)))
293 (deftest :oodm/retrieval/8
294 (with-dataset *ds-employees*
295 (mapcar #'(lambda (ea) (slot-value (slot-value ea 'address) 'street-number))
296 (select 'employee-address :flatp t :order-by [aaddressid] :caching nil)))
297 (10 10 nil nil nil nil))
299 (deftest :oodm/retrieval/9
300 (with-dataset *ds-employees*
301 (mapcar #'(lambda (ea) (slot-value (slot-value ea 'address) 'street-number))
302 (select 'deferred-employee-address :flatp t :order-by [aaddressid] :caching nil)))
303 (10 10 nil nil nil nil))
305 (deftest :oodm/retrieval/10-slot-columns
306 (with-dataset *ds-employees*
308 (select 'employee :flatp t :caching nil
309 :where [<= [emplid] 3]
310 :order-by `((,[emplid] :asc)))))
311 (supplicant :adherent cl-user::novice))
313 ;; tests update-records-from-instance
314 (deftest :oodml/update-records/1
315 (with-dataset *ds-employees*
318 (let ((lenin (car (clsql:select 'employee
319 :where [= 1 [slot-value 'employee 'emplid]]
322 (format nil "~a ~a: ~a"
325 (employee-email lenin))))
327 (setf (slot-value employee1 'first-name) "Dimitriy"
328 (slot-value employee1 'last-name) "Ivanovich"
329 (slot-value employee1 'email) "ivanovich@soviet.org")
330 (clsql:update-records-from-instance employee1)
331 (let ((lenin (car (clsql:select 'employee
332 :where [= 1 [slot-value 'employee 'emplid]]
335 (format nil "~a ~a: ~a"
338 (employee-email lenin))))))
339 "Vladimir Lenin: lenin@soviet.org"
340 "Dimitriy Ivanovich: ivanovich@soviet.org")
342 ;; tests update-record-from-slot
343 (deftest :oodml/update-records/2
344 (with-dataset *ds-employees*
345 ;(start-sql-recording :type :both)
348 (car (clsql:select 'employee
349 :where [= 1 [slot-value 'employee 'emplid]]
353 (setf (slot-value employee1 'email) "lenin-nospam@soviet.org")
354 (clsql:update-record-from-slot employee1 'email)
356 (car (clsql:select 'employee
357 :where [= 1 [slot-value 'employee 'emplid]]
360 "lenin@soviet.org" "lenin-nospam@soviet.org")
362 ;; tests update-record-from-slots
363 (deftest :oodml/update-records/3
364 (with-dataset *ds-employees*
366 (let ((lenin (car (clsql:select 'employee
367 :where [= 1 [slot-value 'employee 'emplid]]
370 (format nil "~a ~a: ~a"
373 (employee-email lenin)))
375 (setf (slot-value employee1 'first-name) "Dimitriy"
376 (slot-value employee1 'last-name) "Ivanovich"
377 (slot-value employee1 'email) "ivanovich@soviet.org")
378 (clsql:update-record-from-slots employee1 '(first-name last-name email))
379 (let ((lenin (car (clsql:select 'employee
380 :where [= 1 [slot-value 'employee 'emplid]]
383 (format nil "~a ~a: ~a"
386 (employee-email lenin))))))
387 "Vladimir Lenin: lenin@soviet.org"
388 "Dimitriy Ivanovich: ivanovich@soviet.org")
390 (deftest :oodml/update-records/4
391 (with-dataset *ds-nodes*
392 (flet ((print-fresh-node ()
393 (let ((base (car (clsql:select 'node
394 :where [= 1 [slot-value 'node 'node-id]]
395 :flatp t :caching nil))))
397 (slot-value base 'node-id)
398 (slot-value base 'title)))))
401 (let ((base (car (clsql:select 'node
402 :where [= 1 [slot-value 'node 'node-id]]
403 :flatp t :caching nil))))
404 (setf (slot-value base 'title) "Altered title")
405 (clsql:update-records-from-instance base)
406 (print-fresh-node)))))
410 (deftest :oodml/update-records/4-slots ;just like 4, but use slots fns.
411 (with-dataset *ds-nodes*
412 (flet ((print-fresh-setting ()
413 (let ((node (car (clsql:select 'setting
414 :where [= 3 [slot-value 'setting 'setting-id]]
415 :flatp t :caching nil))))
416 (format nil "~a ~a ~a"
417 (slot-value node 'setting-id)
418 (slot-value node 'title)
419 (slot-value node 'vars)))))
421 (print-fresh-setting)
422 (let ((node (car (clsql:select 'setting
423 :where [= 3 [slot-value 'setting 'setting-id]]
424 :flatp t :caching nil))))
425 (setf (slot-value node 'title) "Altered title")
426 (setf (slot-value node 'vars) "Altered vars")
427 (clsql-sys:update-record-from-slot node 'title)
428 (clsql-sys:update-record-from-slot node 'vars)
429 (print-fresh-setting))
430 (let ((node (car (clsql:select 'setting
431 :where [= 3 [slot-value 'setting 'setting-id]]
432 :flatp t :caching nil))))
433 (setf (slot-value node 'title) "Setting2")
434 (setf (slot-value node 'vars) "var 2")
435 (clsql:update-records-from-instance node)
436 (clsql-sys:update-record-from-slots node '(vars title))
437 (print-fresh-setting)))))
439 "3 Altered title Altered vars"
442 (deftest :oodml/update-records/5
443 (with-dataset *ds-nodes*
444 (flet ((print-fresh-setting ()
445 (let ((node (car (clsql:select 'setting
446 :where [= 3 [slot-value 'setting 'setting-id]]
447 :flatp t :caching nil))))
448 (format nil "~a ~a ~a"
449 (slot-value node 'setting-id)
450 (slot-value node 'title)
451 (slot-value node 'vars)))))
453 (print-fresh-setting)
454 (let ((node (car (clsql:select 'setting
455 :where [= 3 [slot-value 'setting 'setting-id]]
456 :flatp t :caching nil))))
457 (setf (slot-value node 'title) "Altered title")
458 (setf (slot-value node 'vars) "Altered vars")
459 (clsql:update-records-from-instance node)
460 (print-fresh-setting)))))
462 "3 Altered title Altered vars")
464 (deftest :oodml/update-records/5-slots
465 (with-dataset *ds-nodes*
466 (flet ((print-fresh-setting ()
467 (let ((node (car (clsql:select 'setting
468 :where [= 3 [slot-value 'setting 'setting-id]]
469 :flatp t :caching nil))))
470 (format nil "~a ~a ~a"
471 (slot-value node 'setting-id)
472 (slot-value node 'title)
473 (slot-value node 'vars)))))
475 (print-fresh-setting)
476 (let ((node (car (clsql:select 'setting
477 :where [= 3 [slot-value 'setting 'setting-id]]
478 :flatp t :caching nil))))
479 (setf (slot-value node 'title) "Altered title")
480 (setf (slot-value node 'vars) "Altered vars")
481 (clsql-sys:update-record-from-slot node 'title)
482 (clsql-sys:update-record-from-slot node 'vars)
483 (print-fresh-setting))
484 (let ((node (car (clsql:select 'setting
485 :where [= 3 [slot-value 'setting 'setting-id]]
486 :flatp t :caching nil))))
487 (setf (slot-value node 'title) "Setting2")
488 (setf (slot-value node 'vars) "var 2")
489 (clsql-sys:update-record-from-slots node '(title vars))
490 (print-fresh-setting)))))
492 "3 Altered title Altered vars"
495 (deftest :oodml/update-records/6
496 (with-dataset *ds-nodes*
497 (flet ((print-fresh-setting ()
498 (let ((node (car (clsql:select 'setting
499 :where [= 7 [slot-value 'setting 'setting-id]]
500 :flatp t :caching nil))))
501 (format nil "~a ~a ~a"
502 (slot-value node 'setting-id)
503 (slot-value node 'title)
504 (or (slot-value node 'vars) "NIL")))))
506 (print-fresh-setting)
507 (let ((node (car (clsql:select 'setting
508 :where [= 7 [slot-value 'setting 'setting-id]]
509 :flatp t :caching nil))))
510 (setf (slot-value node 'title) "Altered title")
511 (setf (slot-value node 'vars) "Altered vars")
512 (clsql:update-records-from-instance node)
513 (print-fresh-setting))
514 (let ((node (car (clsql:select 'setting
515 :where [= 7 [slot-value 'setting 'setting-id]]
516 :flatp t :caching nil))))
517 (setf (slot-value node 'title) "theme-2")
518 (setf (slot-value node 'vars) nil)
519 (clsql:update-records-from-instance node)
520 (print-fresh-setting)))))
522 "7 Altered title Altered vars"
525 (deftest :oodml/update-records/7
526 (with-dataset *ds-nodes*
527 (flet ((print-fresh-user ()
528 "requery to get what the db has, and print out."
529 (let ((node (car (clsql:select 'user
530 :where [= 5 [slot-value 'user 'user-id]]
531 :flatp t :caching nil))))
532 (format nil "~a ~a ~a"
533 (slot-value node 'user-id)
534 (slot-value node 'title)
535 (slot-value node 'nick)))))
538 (let ((node (car (clsql:select 'user
539 :where [= 5 [slot-value 'user 'user-id]]
540 :flatp t :caching nil))))
541 (setf (slot-value node 'title) "Altered title")
542 (setf (slot-value node 'nick) "Altered nick")
543 (clsql:update-records-from-instance node)
544 (print-fresh-user)))))
545 "5 user-2 second user"
546 "5 Altered title Altered nick")
548 (deftest :oodml/update-records/8
549 (with-dataset *ds-nodes*
550 (flet ((print-fresh-theme ()
551 (let ((node (car (clsql:select 'theme
552 :where [= 6 [slot-value 'theme 'theme-id]]
553 :flatp t :caching nil))))
554 (with-slots (node-id setting-id theme-id title vars doc) node
555 (format nil "~a ~a ~a ~a ~a ~a"
556 node-id setting-id theme-id
557 title (or vars "NIL") doc)))))
560 (let ((node (car (clsql:select 'setting
561 :where [= 6 [slot-value 'setting 'setting-id]]
562 :flatp t :caching nil))))
563 (setf (slot-value node 'title) "Altered title")
564 (setf (slot-value node 'vars) nil)
565 (clsql:update-records-from-instance node)
567 (let ((node (car (clsql:select 'theme
568 :where [= 6 [slot-value 'theme 'theme-id]]
569 :flatp t :caching nil))))
570 (setf (slot-value node 'title) "Altered title again")
571 (setf (slot-value node 'doc) "altered doc")
572 (clsql:update-records-from-instance node)
574 (let ((node (car (clsql:select 'theme
575 :where [= 6 [slot-value 'theme 'theme-id]]
576 :flatp t :caching nil))))
577 (setf (slot-value node 'title) "theme-1")
578 (setf (slot-value node 'vars) "empty")
579 (setf (slot-value node 'doc) "first theme")
580 (clsql:update-records-from-instance node)
581 (print-fresh-theme)))))
582 "6 6 6 theme-1 empty first theme"
583 "6 6 6 Altered title NIL first theme"
584 "6 6 6 Altered title again NIL altered doc"
585 "6 6 6 theme-1 empty first theme")
587 (deftest :oodml/update-records/9
588 (with-dataset *ds-nodes*
589 (flet ((print-fresh-subloc ()
590 (let ((sl (car (clsql:select 'subloc
591 :where [= 10 [slot-value 'subloc 'subloc-id]]
592 :flatp t :caching nil))))
594 (error "Couldn't find expected sublocation"))
595 (format nil "~a ~a ~a"
596 (slot-value sl 'subloc-id)
597 (slot-value sl 'title)
598 (slot-value sl 'loc)))))
601 (let ((sl (car (clsql:select 'subloc
602 :where [= 10 [slot-value 'subloc 'subloc-id]]
603 :flatp t :caching nil))))
604 (setf (slot-value sl 'title) "Altered subloc title")
605 (setf (slot-value sl 'loc) "Altered loc")
606 (clsql:update-records-from-instance sl)
607 (print-fresh-subloc)))))
608 "10 subloc-1 a subloc"
609 "10 Altered subloc title Altered loc")
611 (deftest :oodml/update-records/9-slots ;like 9, but use slots fns.
612 (with-dataset *ds-nodes*
613 (flet ((print-fresh-subloc ()
614 (let ((sl (car (clsql:select 'subloc
615 :where [= 10 [slot-value 'subloc 'subloc-id]]
616 :flatp t :caching nil))))
618 (error "In psfl: found no sublocation with id = 10"))
619 (format nil "~a ~a ~a"
620 (slot-value sl 'subloc-id)
621 (slot-value sl 'title)
622 (slot-value sl 'loc)))))
625 (let ((sl (car (clsql:select 'subloc
626 :where [= 10 [slot-value 'subloc 'subloc-id]]
627 :flatp t :caching nil))))
629 (error "Select for modification: Found no sublocation with id = 10"))
630 (setf (slot-value sl 'title) "Altered subloc title")
631 (setf (slot-value sl 'loc) "Altered loc")
632 (clsql:update-record-from-slot sl 'title)
633 (clsql:update-record-from-slot sl 'loc)
634 (print-fresh-subloc))
635 (let ((sl (car (clsql:select 'subloc
636 :where [= 10 [slot-value 'subloc 'subloc-id]]
637 :flatp t :caching nil))))
639 (error "Select for next modification: Found no sublocation with id = 10"))
640 (setf (slot-value sl 'title) "subloc-1")
641 (setf (slot-value sl 'loc) "a subloc")
642 (clsql:update-record-from-slots sl '(title loc))
643 (print-fresh-subloc)))))
644 "10 subloc-1 a subloc"
645 "10 Altered subloc title Altered loc"
646 "10 subloc-1 a subloc")
648 ;; Verify that we can set a float to nil and then read it back
649 ;; (was failing in Postgresql at somepoint)
650 (deftest :oodml/update-records/10
651 (with-dataset *ds-employees*
652 (let ((emp (first (clsql:select 'employee :where [= [emplid] 1] :flatp t))))
653 (setf (height emp) nil)
654 (clsql-sys:update-record-from-slot emp 'height)
656 (clsql:select [height] :from [employee] :where [= [emplid] 1])
658 (setf (height emp) 42.0)
659 (clsql-sys:update-record-from-slot emp 'height)
660 (clsql:select [height] :from [employee] :where [= [emplid] 1]))
662 (setf (height emp) 24.13d0)
663 (clsql-sys:update-record-from-slot emp 'height)
664 (clsql:select [height] :from [employee] :where [= [emplid] 1])))))
669 (deftest :oodml/update-records/11
670 (with-dataset *ds-artists*
671 (clsql:update-records-from-instance artist1)
672 (list (name artist1) (artist_id artist1)))
675 (deftest :oodml/update-records/12
676 (with-dataset *ds-artists*
677 (clsql:update-records-from-instance artist1)
678 (list (name artist1) (genre artist1)))
679 ("Mogwai" "Unknown"))
681 ;; tests update-instance-from-records
682 (deftest :oodml/update-instance/1
683 (with-dataset *ds-employees*
685 (format nil "~a ~a: ~a"
686 (slot-value employee1 'first-name)
687 (slot-value employee1 'last-name)
688 (slot-value employee1 'email))
690 (clsql:update-records [employee]
691 :av-pairs '(([first-name] "Ivan")
692 ([last-name] "Petrov")
693 ([email] "petrov@soviet.org"))
694 :where [= [emplid] 1])
695 (clsql:update-instance-from-records employee1)
696 (format nil "~a ~a: ~a"
697 (slot-value employee1 'first-name)
698 (slot-value employee1 'last-name)
699 (slot-value employee1 'email)))))
700 "Vladimir Lenin: lenin@soviet.org"
701 "Ivan Petrov: petrov@soviet.org")
703 ;; tests update-slot-from-record
704 (deftest :oodml/update-instance/2
705 (with-dataset *ds-employees*
707 (slot-value employee1 'email)
709 (clsql:update-records [employee]
710 :av-pairs '(([email] "lenin-nospam@soviet.org"))
711 :where [= [emplid] 1])
712 (clsql:update-slot-from-record employee1 'email)
713 (slot-value employee1 'email))))
714 "lenin@soviet.org" "lenin-nospam@soviet.org")
716 ;; tests normalizedp update-instance-from-records
717 (deftest :oodml/update-instance/3
718 (with-dataset *ds-nodes*
720 (with-output-to-string (out)
721 (format out "~a ~a ~a ~a"
722 (slot-value theme2 'theme-id)
723 (slot-value theme2 'title)
724 (or (slot-value theme2 'vars) "NIL")
725 (slot-value theme2 'doc)))
727 (clsql:update-records [node] :av-pairs '(([title] "Altered title"))
728 :where [= [node-id] 7])
729 (clsql:update-records [setting] :av-pairs '(([vars] "Altered vars"))
730 :where [= [setting-id] 7])
731 (clsql:update-records [theme] :av-pairs '(([doc] "Altered doc"))
732 :where [= [theme-id] 7])
733 (clsql:update-instance-from-records theme2)
734 (with-output-to-string (out)
735 (format out "~a ~a ~a ~a"
736 (slot-value theme2 'theme-id)
737 (slot-value theme2 'title)
738 (slot-value theme2 'vars)
739 (slot-value theme2 'doc))))))
740 "7 theme-2 NIL second theme"
741 "7 Altered title Altered vars Altered doc")
743 (deftest :oodml/update-instance/4
744 (with-dataset *ds-nodes*
747 (setf loc2 (car (clsql:select 'location
748 :where [= [node-id] 9]
749 :flatp t :caching nil)))
751 (slot-value loc2 'node-id)
752 (slot-value loc2 'title)))
754 (clsql:update-records [node] :av-pairs '(([title] "Altered title"))
755 :where [= [node-id] 9])
756 (clsql:update-instance-from-records loc2)
758 (slot-value loc2 'node-id)
759 (slot-value loc2 'title)))))
763 (deftest :oodml/update-instance/5
764 (with-dataset *ds-nodes*
766 (format nil "~a ~a ~a"
767 (slot-value subloc2 'subloc-id)
768 (slot-value subloc2 'title)
769 (slot-value subloc2 'loc))
771 (clsql:update-records [node] :av-pairs '(([title] "Altered title"))
772 :where [= [node-id] 11])
773 (clsql:update-records [subloc] :av-pairs '(([loc] "Altered loc"))
774 :where [= [subloc-id] 11])
775 (clsql:update-instance-from-records subloc2)
776 (format nil "~a ~a ~a"
777 (slot-value subloc2 'subloc-id)
778 (slot-value subloc2 'title)
779 (slot-value subloc2 'loc)))))
780 "11 subloc-2 second subloc"
781 "11 Altered title Altered loc")
783 ;; tests update-slot-from-record with normalizedp stuff
784 (deftest :oodml/update-instance/6
785 (with-dataset *ds-nodes*
787 (slot-value theme1 'doc)
788 (slot-value theme1 'vars)
790 (clsql:update-records [theme]
791 :av-pairs '(([doc] "altered doc"))
792 :where [= [theme-id] 6])
793 (clsql:update-slot-from-record theme1 'doc)
794 (slot-value theme1 'doc))
796 (clsql:update-records [setting]
797 :av-pairs '(([vars] "altered vars"))
798 :where [= [setting-id] 6])
799 (clsql:update-slot-from-record theme1 'vars)
800 (slot-value theme1 'vars))))
801 "first theme" "empty"
802 "altered doc" "altered vars")
804 (deftest :oodml/update-instance/7
805 (flet ((print-loc (l)
807 (slot-value l 'node-id) (slot-value l 'title)))
810 (slot-value sl 'node-id) (slot-value sl 'loc))))
811 (with-dataset *ds-nodes*
814 (print-subloc subloc2)
816 (clsql:update-records [node]
817 :av-pairs '(([title] "altered title"))
818 :where [= [node-id] (node-id loc2)])
819 (clsql:update-slot-from-record loc2 'title)
822 (clsql:update-records [subloc]
823 :av-pairs '(([loc] "altered loc"))
824 :where [= [subloc-id] (subloc-id subloc2)])
825 (clsql:update-slot-from-record subloc2 'loc)
826 (print-subloc subloc2)))))
827 "9: location-2" "11: second subloc"
828 "9: altered title" "11: altered loc")
830 (deftest :oodml/do-query/1
831 (with-dataset *ds-employees*
833 (clsql:do-query ((e) [select 'employee :order-by [emplid]])
834 (push (slot-value e 'last-name) result))
836 ("Putin" "Yeltsin" "Gorbachev" "Chernenko" "Andropov" "Brezhnev" "Kruschev"
837 "Trotsky" "Stalin" "Lenin"))
839 (deftest :oodml/do-query/2
840 (with-dataset *ds-employees*
842 (clsql:do-query ((e c) [select 'employee 'company
843 :where [= [slot-value 'employee 'last-name]
845 (push (list (slot-value e 'last-name) (slot-value c 'name))
848 (("Lenin" "Widgets Inc.")))
850 (deftest :oodml/map-query/1
851 (with-dataset *ds-employees*
852 (clsql:map-query 'list #'last-name [select 'employee :order-by [emplid]]))
853 ("Lenin" "Stalin" "Trotsky" "Kruschev" "Brezhnev" "Andropov" "Chernenko"
854 "Gorbachev" "Yeltsin" "Putin"))
856 (deftest :oodml/map-query/2
857 (with-dataset *ds-employees*
858 (clsql:map-query 'list #'(lambda (e c) (list (slot-value e 'last-name)
859 (slot-value c 'name)))
860 [select 'employee 'company :where [= [slot-value 'employee 'last-name]
862 (("Lenin" "Widgets Inc.")))
864 (deftest :oodml/iteration/3
865 (with-dataset *ds-employees*
866 (loop for (e) being the records in
867 [select 'employee :where [< [emplid] 4] :order-by [emplid]]
868 collect (slot-value e 'last-name)))
869 ("Lenin" "Stalin" "Trotsky"))
872 (deftest :oodml/cache/1
873 (with-dataset *ds-employees*
874 (let ((*default-caching* t))
875 (setf (clsql-sys:record-caches *default-database*) nil)
876 (let ((employees (select 'employee)))
877 (every #'(lambda (a b) (eq a b))
878 employees (select 'employee)))))
881 (deftest :oodml/cache/2
882 (with-dataset *ds-employees*
883 (let* ((*default-caching* t)
884 (employees (select 'employee)))
885 (equal employees (select 'employee :flatp t))))
888 (deftest :oodml/refresh/1
889 (with-dataset *ds-employees*
890 (let* ((clsql-sys:*default-caching* t)
891 (addresses (select 'address)))
892 (equal addresses (select 'address :refresh t))))
895 (deftest :oodml/refresh/2
896 (with-dataset *ds-employees*
897 (let* ((clsql-sys:*default-caching* t)
898 (addresses (select 'address :order-by [addressid] :flatp t :refresh t))
899 (city (slot-value (car addresses) 'city)))
900 (clsql:update-records [addr]
901 :av-pairs '((city_field "A new city"))
902 :where [= [addressid] (slot-value (car addresses) 'addressid)])
903 (let* ((new-addresses (select 'address :order-by [addressid] :refresh t :flatp t))
904 (new-city (slot-value (car addresses) 'city))
906 (clsql:update-records [addr]
907 :av-pairs `((city_field ,city))
908 :where [= [addressid] (slot-value (car addresses) 'addressid)])
909 (values (equal addresses new-addresses)
912 t "Leningrad" "A new city")
914 (deftest :oodml/refresh/3
915 (with-dataset *ds-employees*
916 (let* ((clsql-sys:*default-caching* t)
917 (addresses (select 'address :order-by [addressid] :flatp t)))
919 (equal addresses (select 'address :refresh t :flatp t))
920 (equal addresses (select 'address :flatp t)))))
923 (deftest :oodml/refresh/4
924 (with-dataset *ds-employees*
925 (let* ((clsql-sys:*default-caching* t)
926 (addresses (select 'address :order-by [addressid] :flatp t :refresh t))
928 (make-instance 'address :addressid 1000 :city "A new address city")
929 (let ((new-addresses (select 'address :order-by [addressid] :flatp t :refresh t)))
932 (length new-addresses)
933 (eq (first addresses) (first new-addresses))
934 (eq (second addresses) (second new-addresses))))))
938 (deftest :oodml/uoj/full-set
939 (with-dataset *ds-employees*
941 (let* ((dea-list (select 'deferred-employee-address
942 :caching nil :order-by ["ea_join" aaddressid]
944 (dea-list-copy (copy-seq dea-list))
945 (initially-unbound (every #'(lambda (dea) (not (slot-boundp dea 'address))) dea-list)))
946 (update-objects-joins dea-list :slots 'address :max-len nil)
949 (equal dea-list dea-list-copy)
950 (every #'(lambda (dea) (slot-boundp dea 'address)) dea-list)
951 (every #'(lambda (dea) (typep (slot-value dea 'address) 'address)) dea-list)
952 (mapcar #'(lambda (dea) (slot-value (slot-value dea 'address) 'addressid)) dea-list)))))
953 t t t t (1 1 2 2 2 3))
955 (deftest :oodml/uoj/batched
956 (with-dataset *ds-employees*
958 (let* ((dea-list (select 'deferred-employee-address
959 :caching nil :order-by ["ea_join" aaddressid]
961 (dea-list-copy (copy-seq dea-list))
962 (initially-unbound (every #'(lambda (dea) (not (slot-boundp dea 'address))) dea-list)))
963 (update-objects-joins dea-list :slots 'address :max-len 2)
966 (equal dea-list dea-list-copy)
967 (every #'(lambda (dea) (slot-boundp dea 'address)) dea-list)
968 (every #'(lambda (dea) (typep (slot-value dea 'address) 'address)) dea-list)
969 (mapcar #'(lambda (dea) (slot-value (slot-value dea 'address) 'addressid)) dea-list)))))
970 t t t t (1 1 2 2 2 3))
972 ;; update-object-joins needs to be fixed for multiple keys
974 (deftest :oodml/uoj/multi-key
976 (clsql:update-objects-joins (list company1))
977 (mapcar #'(lambda (e)
978 (slot-value e 'ecompanyid))
979 (company-employees company1)))
980 (1 1 1 1 1 1 1 1 1 1))
982 (deftest :oodml/big/1
983 (with-dataset *ds-big*
984 (let ((objs (clsql:select 'big :order-by [i] :flatp t)))
989 (rest objs (cdr rest)))
990 ((= i (length objs)) t)
991 (let ((obj (car rest))
993 (unless (and (eql (slot-value obj 'i) index)
994 (eql (slot-value obj 'bi) (truncate max index)))
1000 (deftest :oodml/db-auto-sync/1
1001 (with-dataset *ds-employees*
1004 (make-instance 'employee :emplid 20 :groupid 1
1005 :last-name "Ivanovich")
1006 (select [last-name] :from [employee] :where [= [emplid] 20]
1007 :flatp t :field-names nil))
1008 (let ((*db-auto-sync* t))
1009 (make-instance 'employee :emplid 20 :groupid 1
1010 :last-name "Ivanovich")
1011 (prog1 (select [last-name] :from [employee] :flatp t
1013 :where [= [emplid] 20])
1014 (delete-records :from [employee] :where [= [emplid] 20])))))
1017 (deftest :oodml/db-auto-sync/2
1018 (with-dataset *ds-employees*
1020 (let ((instance (make-instance 'employee :emplid 20 :groupid 1
1021 :last-name "Ivanovich")))
1022 (setf (slot-value instance 'last-name) "Bulgakov")
1023 (select [last-name] :from [employee] :where [= [emplid] 20]
1024 :flatp t :field-names nil))
1025 (let* ((*db-auto-sync* t)
1026 (instance (make-instance 'employee :emplid 20 :groupid 1
1027 :last-name "Ivanovich")))
1028 (setf (slot-value instance 'last-name) "Bulgakov")
1029 (prog1 (select [last-name] :from [employee] :flatp t
1031 :where [= [emplid] 20])
1032 (delete-records :from [employee] :where [= [emplid] 20])))))
1035 (deftest :oodml/db-auto-sync/3
1036 (with-dataset *ds-nodes*
1039 (make-instance 'theme :title "test-theme" :vars "test-vars"
1041 (select [node-id] :from [node] :where [= [title] "test-theme"]
1042 :flatp t :field-names nil))
1043 (let ((*db-auto-sync* t))
1044 (make-instance 'theme :title "test-theme" :vars "test-vars"
1046 (prog1 (select [title] :from [node] :where [= [title] "test-theme"]
1047 :flatp t :field-names nil)
1048 (delete-records :from [node] :where [= [title] "test-theme"])
1049 (delete-records :from [setting] :where [= [vars] "test-vars"])
1050 (delete-records :from [theme] :where [= [doc] "test-doc"])))))
1053 (deftest :oodml/db-auto-sync/4
1054 (with-dataset *ds-nodes*
1056 (let ((inst (make-instance 'theme
1057 :title "test-theme" :vars "test-vars"
1059 (*print-circle* nil))
1060 (setf (slot-value inst 'title) "alternate-test-theme")
1061 (format nil "~a ~a ~a ~a"
1062 (or (select [title] :from [node]
1063 :where [= [title] "test-theme"]
1064 :flatp t :field-names nil) "NIL")
1065 (or (select [vars] :from [setting]
1066 :where [= [vars] "test-vars"]
1067 :flatp t :field-names nil) "NIL")
1068 (or (select [doc] :from [theme]
1069 :where [= [doc] "test-doc"]
1070 :flatp t :field-names nil) "NIL")
1071 (or (select [title] :from [node]
1072 :where [= [title] "alternate-test-theme"]
1073 :flatp t :field-names nil) "NIL")))
1074 (let* ((*db-auto-sync* t)
1075 (inst (make-instance 'theme
1076 :title "test-theme" :vars "test-vars"
1078 (setf (slot-value inst 'title) "alternate-test-theme")
1080 (format nil "~a ~a ~a ~a"
1081 (or (select [title] :from [node]
1082 :where [= [title] "test-theme"]
1083 :flatp t :field-names nil) "NIL")
1084 (or (select [vars] :from [setting]
1085 :where [= [vars] "test-vars"]
1086 :flatp t :field-names nil) "NIL")
1087 (or (select [doc] :from [theme]
1088 :where [= [doc] "test-doc"]
1089 :flatp t :field-names nil) "NIL")
1090 (or (select [title] :from [node]
1091 :where [= [title] "alternate-test-theme"]
1092 :flatp t :field-names nil) "NIL"))
1093 (delete-records :from [node] :where [= [title] "alternate-test-theme"])
1094 (delete-records :from [setting] :where [= [vars] "test-vars"])
1095 (delete-records :from [theme] :where [= [doc] "test-doc"])))))
1097 "NIL (test-vars) (test-doc) (alternate-test-theme)")
1099 (deftest :oodml/setf-slot-value/1
1100 (with-dataset *ds-employees*
1101 (let* ((*db-auto-sync* t)
1102 (instance (make-instance 'employee :emplid 20 :groupid 1)))
1105 (slot-value instance 'first-name) "Mikhail"
1106 (slot-value instance 'last-name) "Bulgakov")
1107 (delete-records :from [employee] :where [= [emplid] 20]))))
1110 (deftest :oodml/float/1
1111 (with-dataset *ds-employees*
1112 (let* ((emp1 (car (select 'employee
1113 :where [= [slot-value 'employee 'emplid]
1117 (height (slot-value emp1 'height)))
1120 (setf (slot-value emp1 'height) 1.0E0)
1121 (clsql:update-record-from-slot emp1 'height)
1122 (= (car (clsql:select [height] :from [employee]
1123 :where [= [emplid] 1]
1127 (setf (slot-value emp1 'height) height)
1128 (clsql:update-record-from-slot emp1 'height))))
1131 (deftest :oodml/float/2
1132 (with-dataset *ds-employees*
1133 (let* ((emp1 (car (select 'employee
1134 :where [= [slot-value 'employee 'emplid]
1138 (height (slot-value emp1 'height)))
1141 (setf (slot-value emp1 'height) 1.0S0)
1142 (clsql:update-record-from-slot emp1 'height)
1143 (= (car (clsql:select [height] :from [employee]
1144 :where [= [emplid] 1]
1148 (setf (slot-value emp1 'height) height)
1149 (clsql:update-record-from-slot emp1 'height))))
1152 (deftest :oodml/float/3
1153 (with-dataset *ds-employees*
1154 (let* ((emp1 (car (select 'employee
1155 :where [= [slot-value 'employee 'emplid]
1159 (height (slot-value emp1 'height)))
1162 (setf (slot-value emp1 'height) 1.0F0)
1163 (clsql:update-record-from-slot emp1 'height)
1164 (= (car (clsql:select [height] :from [employee]
1165 :where [= [emplid] 1]
1169 (setf (slot-value emp1 'height) height)
1170 (clsql:update-record-from-slot emp1 'height))))
1173 (deftest :oodml/float/4
1174 (with-dataset *ds-employees*
1175 (let* ((emp1 (car (select 'employee
1176 :where [= [slot-value 'employee 'emplid]
1180 (height (slot-value emp1 'height)))
1183 (setf (slot-value emp1 'height) 1.0D0)
1184 (clsql:update-record-from-slot emp1 'height)
1185 (= (car (clsql:select [height] :from [employee]
1186 :where [= [emplid] 1]
1190 (setf (slot-value emp1 'height) height)
1191 (clsql:update-record-from-slot emp1 'height))))
1194 (deftest :oodml/float/5
1195 (with-dataset *ds-employees*
1196 (let* ((emp1 (car (select 'employee
1197 :where [= [slot-value 'employee 'emplid]
1201 (height (slot-value emp1 'height)))
1204 (setf (slot-value emp1 'height) 1.0L0)
1205 (clsql:update-record-from-slot emp1 'height)
1206 (= (car (clsql:select [height] :from [employee]
1207 :where [= [emplid] 1]
1211 (setf (slot-value emp1 'height) height)
1212 (clsql:update-record-from-slot emp1 'height))))