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/select/1
25 (with-dataset *ds-employees*
26 (mapcar #'(lambda (e) (slot-value e 'last-name))
27 (clsql:select 'employee :order-by [last-name] :flatp t :caching nil)))
28 ("Andropov" "Brezhnev" "Chernenko" "Gorbachev" "Kruschev" "Lenin" "Putin"
29 "Stalin" "Trotsky" "Yeltsin"))
31 (deftest :oodml/select/2
32 (with-dataset *ds-employees*
33 (mapcar #'(lambda (e) (slot-value e 'name))
34 (clsql:select 'company :flatp t :caching nil)))
37 (deftest :oodml/select/3
38 (with-dataset *ds-employees*
39 (mapcar #'(lambda (e) (slot-value e 'ecompanyid))
40 (clsql:select 'employee
41 :where [and [= [slot-value 'employee 'ecompanyid]
42 [slot-value 'company 'companyid]]
43 [= [slot-value 'company 'name]
47 (1 1 1 1 1 1 1 1 1 1))
49 (deftest :oodml/select/4
50 (with-dataset *ds-employees*
52 (concatenate 'string (slot-value e 'first-name)
54 (slot-value e 'last-name)))
55 (clsql:select 'employee :where [= [slot-value 'employee 'first-name]
60 ("Vladimir Lenin" "Vladimir Putin"))
62 (deftest :oodml/select/5
63 (with-dataset *ds-employees*
64 (length (clsql:select 'employee :where [married] :flatp t :caching nil)))
67 (deftest :oodml/select/6
68 (with-dataset *ds-employees*
69 (let ((a (caar (clsql:select 'address :where [= 1 [addressid]] :caching nil))))
71 (slot-value a 'street-number)
72 (slot-value a 'street-name)
74 (slot-value a 'postal-code))))
75 10 "Park Place" "Leningrad" 123)
77 (deftest :oodml/select/7
78 (with-dataset *ds-employees*
79 (let ((a (caar (clsql:select 'address :where [= 2 [addressid]] :caching nil))))
81 (slot-value a 'street-number)
82 (slot-value a 'street-name)
84 (slot-value a 'postal-code))))
87 (deftest :oodml/select/8
88 (with-dataset *ds-employees*
89 (mapcar #'(lambda (e) (slot-value e 'married))
90 (clsql:select 'employee :flatp t :order-by [emplid] :caching nil)))
91 (t t t nil nil nil nil nil nil nil))
93 (deftest :oodml/select/9
94 (with-dataset *ds-employees*
95 (mapcar #'(lambda (pair)
97 (typep (car pair) 'address)
98 (typep (second pair) 'employee-address)
99 (slot-value (car pair) 'addressid)
100 (slot-value (second pair) 'aaddressid)
101 (slot-value (second pair) 'aemplid)))
102 (employee-addresses employee1)))
103 ((t t 1 1 1) (t t 2 2 1)))
105 (deftest :oodml/select/10
106 (with-dataset *ds-employees*
107 (mapcar #'(lambda (pair)
109 (typep (car pair) 'address)
110 (typep (second pair) 'employee-address)
111 (slot-value (car pair) 'addressid)
112 (slot-value (second pair) 'aaddressid)
113 (slot-value (second pair) 'aemplid)))
114 (employee-addresses employee2)))
117 (deftest :oodml/select/11
118 (with-dataset *ds-employees*
119 (values (mapcar #'(lambda (x) (slot-value x 'emplid))
120 (clsql:select 'employee :order-by '(([emplid] :asc))
122 (mapcar #'(lambda (x) (slot-value x 'emplid))
123 (clsql:select 'employee :order-by '(([emplid] :desc))
125 (1 2 3 4 5 6 7 8 9 10)
126 (10 9 8 7 6 5 4 3 2 1))
128 ;; test retrieval of node, derived nodes etc
129 (deftest :oodml/select/12
130 (with-dataset *ds-nodes*
131 (length (clsql:select 'node :where [not [null [node-id]]] :flatp t :caching nil)))
134 (deftest :oodml/select/13
135 (with-dataset *ds-nodes*
136 (let ((a (car (clsql:select 'node :where [= 1 [node-id]] :flatp t :caching nil))))
138 (slot-value a 'node-id)
139 (slot-value a 'title))))
142 (deftest :oodml/select/14
143 (with-dataset *ds-nodes*
144 (length (clsql:select 'setting :where [not [null [setting-id]]] :flatp t :caching nil)))
147 (deftest :oodml/select/15
148 (with-dataset *ds-nodes*
149 (let ((a (car (clsql:select 'setting :where [= 3 [setting-id]] :flatp t :caching nil))))
151 (slot-value a 'node-id)
152 (slot-value a 'setting-id)
153 (slot-value a 'title)
154 (slot-value a 'vars))))
155 3 3 "Setting2" "var 2")
157 (deftest :oodml/select/16
158 (with-dataset *ds-nodes*
159 (length (clsql:select 'user :where [not [null [user-id]]] :flatp t :caching nil)))
162 (deftest :oodml/select/17
163 (with-dataset *ds-nodes*
164 (let ((a (car (clsql:select 'user :where [= 4 [user-id]] :flatp t :caching nil))))
166 (slot-value a 'node-id)
167 (slot-value a 'user-id)
168 (slot-value a 'title)
169 (slot-value a 'nick))))
170 4 4 "user-1" "first user")
172 (deftest :oodml/select/18
173 (with-dataset *ds-nodes*
174 (length (clsql:select 'theme :where [not [null [theme-id]]] :flatp t :caching nil)))
177 (deftest :oodml/select/19
178 (with-dataset *ds-nodes*
179 (let ((a (car (clsql:select 'theme :where [= 6 [theme-id]] :flatp t :caching nil))))
180 (slot-value a 'theme-id)))
183 (deftest :oodml/select/20
184 (with-dataset *ds-nodes*
185 (let ((a (car (clsql:select 'theme :where [= 7 [theme-id]] :flatp t :caching nil))))
187 (slot-value a 'node-id)
188 (slot-value a 'theme-id)
189 (slot-value a 'title)
196 ;; Some tests to check weird subclassed nodes (node without own table, or subclassed of same)
197 (deftest :oodml/select/21
198 (with-dataset *ds-nodes*
199 (let ((a (car (clsql:select 'location :where [= [title] "location-1"] :flatp t :caching nil))))
201 (slot-value a 'node-id)
202 (slot-value a 'title))))
205 (deftest :oodml/select/22
206 (with-dataset *ds-nodes*
207 (let ((a (car (clsql:select 'subloc :where [not [null [subloc-id]]] :flatp t :caching nil))))
209 (slot-value a 'node-id)
210 (slot-value a 'subloc-id)
211 (slot-value a 'title)
212 (slot-value a 'loc))))
213 10 10 "subloc-1" "a subloc")
215 (deftest :oodml/select/23
216 (with-dataset *ds-artists*
217 (length (clsql:select 'artist :flatp t :caching nil)))
222 ;; test retrieval is deferred
223 (deftest :oodm/retrieval/1
224 (with-dataset *ds-employees*
225 (every #'(lambda (e) (not (slot-boundp e 'company)))
226 (select 'employee :flatp t :caching nil)))
229 (deftest :oodm/retrieval/2
230 (with-dataset *ds-employees*
231 (every #'(lambda (e) (not (slot-boundp e 'address)))
232 (select 'deferred-employee-address :flatp t :caching nil)))
235 ;; :retrieval :immediate should be boundp before accessed
236 (deftest :oodm/retrieval/3
237 (with-dataset *ds-employees*
238 (every #'(lambda (ea) (slot-boundp ea 'address))
239 (select 'employee-address :flatp t :caching nil)))
242 (deftest :oodm/retrieval/4
243 (with-dataset *ds-employees*
244 (mapcar #'(lambda (ea) (typep (slot-value ea 'address) 'address))
245 (select 'employee-address :flatp t :caching nil)))
248 (deftest :oodm/retrieval/5
249 (with-dataset *ds-employees*
250 (mapcar #'(lambda (ea) (typep (slot-value ea 'address) 'address))
251 (select 'deferred-employee-address :flatp t :caching nil)))
254 (deftest :oodm/retrieval/6
255 (with-dataset *ds-employees*
256 (every #'(lambda (ea) (slot-boundp (slot-value ea 'address) 'addressid))
257 (select 'employee-address :flatp t :caching nil)))
260 (deftest :oodm/retrieval/7
261 (with-dataset *ds-employees*
262 (every #'(lambda (ea) (slot-boundp (slot-value ea 'address) 'addressid))
263 (select 'deferred-employee-address :flatp t :caching nil)))
266 (deftest :oodm/retrieval/8
267 (with-dataset *ds-employees*
268 (mapcar #'(lambda (ea) (slot-value (slot-value ea 'address) 'street-number))
269 (select 'employee-address :flatp t :order-by [aaddressid] :caching nil)))
272 (deftest :oodm/retrieval/9
273 (with-dataset *ds-employees*
274 (mapcar #'(lambda (ea) (slot-value (slot-value ea 'address) 'street-number))
275 (select 'deferred-employee-address :flatp t :order-by [aaddressid] :caching nil)))
278 ;; tests update-records-from-instance
279 (deftest :oodml/update-records/1
280 (with-dataset *ds-employees*
283 (let ((lenin (car (clsql:select 'employee
284 :where [= 1 [slot-value 'employee 'emplid]]
287 (format nil "~a ~a: ~a"
290 (employee-email lenin))))
292 (setf (slot-value employee1 'first-name) "Dimitriy"
293 (slot-value employee1 'last-name) "Ivanovich"
294 (slot-value employee1 'email) "ivanovich@soviet.org")
295 (clsql:update-records-from-instance employee1)
296 (let ((lenin (car (clsql:select 'employee
297 :where [= 1 [slot-value 'employee 'emplid]]
300 (format nil "~a ~a: ~a"
303 (employee-email lenin))))))
304 "Vladimir Lenin: lenin@soviet.org"
305 "Dimitriy Ivanovich: ivanovich@soviet.org")
307 ;; tests update-record-from-slot
308 (deftest :oodml/update-records/2
309 (with-dataset *ds-employees*
310 ;(start-sql-recording :type :both)
313 (car (clsql:select 'employee
314 :where [= 1 [slot-value 'employee 'emplid]]
318 (setf (slot-value employee1 'email) "lenin-nospam@soviet.org")
319 (clsql:update-record-from-slot employee1 'email)
321 (car (clsql:select 'employee
322 :where [= 1 [slot-value 'employee 'emplid]]
325 "lenin@soviet.org" "lenin-nospam@soviet.org")
327 ;; tests update-record-from-slots
328 (deftest :oodml/update-records/3
329 (with-dataset *ds-employees*
331 (let ((lenin (car (clsql:select 'employee
332 :where [= 1 [slot-value 'employee 'emplid]]
335 (format nil "~a ~a: ~a"
338 (employee-email lenin)))
340 (setf (slot-value employee1 'first-name) "Dimitriy"
341 (slot-value employee1 'last-name) "Ivanovich"
342 (slot-value employee1 'email) "ivanovich@soviet.org")
343 (clsql:update-record-from-slots employee1 '(first-name last-name email))
344 (let ((lenin (car (clsql:select 'employee
345 :where [= 1 [slot-value 'employee 'emplid]]
348 (format nil "~a ~a: ~a"
351 (employee-email lenin))))))
352 "Vladimir Lenin: lenin@soviet.org"
353 "Dimitriy Ivanovich: ivanovich@soviet.org")
355 (deftest :oodml/update-records/4
356 (with-dataset *ds-nodes*
357 (flet ((print-fresh-node ()
358 (let ((base (car (clsql:select 'node
359 :where [= 1 [slot-value 'node 'node-id]]
360 :flatp t :caching nil))))
362 (slot-value base 'node-id)
363 (slot-value base 'title)))))
366 (let ((base (car (clsql:select 'node
367 :where [= 1 [slot-value 'node 'node-id]]
368 :flatp t :caching nil))))
369 (setf (slot-value base 'title) "Altered title")
370 (clsql:update-records-from-instance base)
371 (print-fresh-node)))))
375 (deftest :oodml/update-records/4-slots ;just like 4, but use slots fns.
376 (with-dataset *ds-nodes*
377 (flet ((print-fresh-setting ()
378 (let ((node (car (clsql:select 'setting
379 :where [= 3 [slot-value 'setting 'setting-id]]
380 :flatp t :caching nil))))
381 (format nil "~a ~a ~a"
382 (slot-value node 'setting-id)
383 (slot-value node 'title)
384 (slot-value node 'vars)))))
386 (print-fresh-setting)
387 (let ((node (car (clsql:select 'setting
388 :where [= 3 [slot-value 'setting 'setting-id]]
389 :flatp t :caching nil))))
390 (setf (slot-value node 'title) "Altered title")
391 (setf (slot-value node 'vars) "Altered vars")
392 (clsql-sys:update-record-from-slot node 'title)
393 (clsql-sys:update-record-from-slot node 'vars)
394 (print-fresh-setting))
395 (let ((node (car (clsql:select 'setting
396 :where [= 3 [slot-value 'setting 'setting-id]]
397 :flatp t :caching nil))))
398 (setf (slot-value node 'title) "Setting2")
399 (setf (slot-value node 'vars) "var 2")
400 (clsql:update-records-from-instance node)
401 (clsql-sys:update-record-from-slots node '(vars title))
402 (print-fresh-setting)))))
404 "3 Altered title Altered vars"
407 (deftest :oodml/update-records/5
408 (with-dataset *ds-nodes*
409 (flet ((print-fresh-setting ()
410 (let ((node (car (clsql:select 'setting
411 :where [= 3 [slot-value 'setting 'setting-id]]
412 :flatp t :caching nil))))
413 (format nil "~a ~a ~a"
414 (slot-value node 'setting-id)
415 (slot-value node 'title)
416 (slot-value node 'vars)))))
418 (print-fresh-setting)
419 (let ((node (car (clsql:select 'setting
420 :where [= 3 [slot-value 'setting 'setting-id]]
421 :flatp t :caching nil))))
422 (setf (slot-value node 'title) "Altered title")
423 (setf (slot-value node 'vars) "Altered vars")
424 (clsql:update-records-from-instance node)
425 (print-fresh-setting)))))
427 "3 Altered title Altered vars")
429 (deftest :oodml/update-records/5-slots
430 (with-dataset *ds-nodes*
431 (flet ((print-fresh-setting ()
432 (let ((node (car (clsql:select 'setting
433 :where [= 3 [slot-value 'setting 'setting-id]]
434 :flatp t :caching nil))))
435 (format nil "~a ~a ~a"
436 (slot-value node 'setting-id)
437 (slot-value node 'title)
438 (slot-value node 'vars)))))
440 (print-fresh-setting)
441 (let ((node (car (clsql:select 'setting
442 :where [= 3 [slot-value 'setting 'setting-id]]
443 :flatp t :caching nil))))
444 (setf (slot-value node 'title) "Altered title")
445 (setf (slot-value node 'vars) "Altered vars")
446 (clsql-sys:update-record-from-slot node 'title)
447 (clsql-sys:update-record-from-slot node 'vars)
448 (print-fresh-setting))
449 (let ((node (car (clsql:select 'setting
450 :where [= 3 [slot-value 'setting 'setting-id]]
451 :flatp t :caching nil))))
452 (setf (slot-value node 'title) "Setting2")
453 (setf (slot-value node 'vars) "var 2")
454 (clsql-sys:update-record-from-slots node '(title vars))
455 (print-fresh-setting)))))
457 "3 Altered title Altered vars"
460 (deftest :oodml/update-records/6
461 (with-dataset *ds-nodes*
462 (flet ((print-fresh-setting ()
463 (let ((node (car (clsql:select 'setting
464 :where [= 7 [slot-value 'setting 'setting-id]]
465 :flatp t :caching nil))))
466 (format nil "~a ~a ~a"
467 (slot-value node 'setting-id)
468 (slot-value node 'title)
469 (or (slot-value node 'vars) "NIL")))))
471 (print-fresh-setting)
472 (let ((node (car (clsql:select 'setting
473 :where [= 7 [slot-value 'setting 'setting-id]]
474 :flatp t :caching nil))))
475 (setf (slot-value node 'title) "Altered title")
476 (setf (slot-value node 'vars) "Altered vars")
477 (clsql:update-records-from-instance node)
478 (print-fresh-setting))
479 (let ((node (car (clsql:select 'setting
480 :where [= 7 [slot-value 'setting 'setting-id]]
481 :flatp t :caching nil))))
482 (setf (slot-value node 'title) "theme-2")
483 (setf (slot-value node 'vars) nil)
484 (clsql:update-records-from-instance node)
485 (print-fresh-setting)))))
487 "7 Altered title Altered vars"
490 (deftest :oodml/update-records/7
491 (with-dataset *ds-nodes*
492 (flet ((print-fresh-user ()
493 "requery to get what the db has, and print out."
494 (let ((node (car (clsql:select 'user
495 :where [= 5 [slot-value 'user 'user-id]]
496 :flatp t :caching nil))))
497 (format nil "~a ~a ~a"
498 (slot-value node 'user-id)
499 (slot-value node 'title)
500 (slot-value node 'nick)))))
503 (let ((node (car (clsql:select 'user
504 :where [= 5 [slot-value 'user 'user-id]]
505 :flatp t :caching nil))))
506 (setf (slot-value node 'title) "Altered title")
507 (setf (slot-value node 'nick) "Altered nick")
508 (clsql:update-records-from-instance node)
509 (print-fresh-user)))))
510 "5 user-2 second user"
511 "5 Altered title Altered nick")
513 (deftest :oodml/update-records/8
514 (with-dataset *ds-nodes*
515 (flet ((print-fresh-theme ()
516 (let ((node (car (clsql:select 'theme
517 :where [= 6 [slot-value 'theme 'theme-id]]
518 :flatp t :caching nil))))
519 (with-slots (node-id setting-id theme-id title vars doc) node
520 (format nil "~a ~a ~a ~a ~a ~a"
521 node-id setting-id theme-id
522 title (or vars "NIL") doc)))))
525 (let ((node (car (clsql:select 'setting
526 :where [= 6 [slot-value 'setting 'setting-id]]
527 :flatp t :caching nil))))
528 (setf (slot-value node 'title) "Altered title")
529 (setf (slot-value node 'vars) nil)
530 (clsql:update-records-from-instance node)
532 (let ((node (car (clsql:select 'theme
533 :where [= 6 [slot-value 'theme 'theme-id]]
534 :flatp t :caching nil))))
535 (setf (slot-value node 'title) "Altered title again")
536 (setf (slot-value node 'doc) "altered doc")
537 (clsql:update-records-from-instance node)
539 (let ((node (car (clsql:select 'theme
540 :where [= 6 [slot-value 'theme 'theme-id]]
541 :flatp t :caching nil))))
542 (setf (slot-value node 'title) "theme-1")
543 (setf (slot-value node 'vars) "empty")
544 (setf (slot-value node 'doc) "first theme")
545 (clsql:update-records-from-instance node)
546 (print-fresh-theme)))))
547 "6 6 6 theme-1 empty first theme"
548 "6 6 6 Altered title NIL first theme"
549 "6 6 6 Altered title again NIL altered doc"
550 "6 6 6 theme-1 empty first theme")
552 (deftest :oodml/update-records/9
553 (with-dataset *ds-nodes*
554 (flet ((print-fresh-subloc ()
555 (let ((sl (car (clsql:select 'subloc
556 :where [= 10 [slot-value 'subloc 'subloc-id]]
557 :flatp t :caching nil))))
559 (error "Couldn't find expected sublocation"))
560 (format nil "~a ~a ~a"
561 (slot-value sl 'subloc-id)
562 (slot-value sl 'title)
563 (slot-value sl 'loc)))))
566 (let ((sl (car (clsql:select 'subloc
567 :where [= 10 [slot-value 'subloc 'subloc-id]]
568 :flatp t :caching nil))))
569 (setf (slot-value sl 'title) "Altered subloc title")
570 (setf (slot-value sl 'loc) "Altered loc")
571 (clsql:update-records-from-instance sl)
572 (print-fresh-subloc)))))
573 "10 subloc-1 a subloc"
574 "10 Altered subloc title Altered loc")
576 (deftest :oodml/update-records/9-slots ;like 9, but use slots fns.
577 (with-dataset *ds-nodes*
578 (flet ((print-fresh-subloc ()
579 (let ((sl (car (clsql:select 'subloc
580 :where [= 10 [slot-value 'subloc 'subloc-id]]
581 :flatp t :caching nil))))
583 (error "In psfl: found no sublocation with id = 10"))
584 (format nil "~a ~a ~a"
585 (slot-value sl 'subloc-id)
586 (slot-value sl 'title)
587 (slot-value sl 'loc)))))
590 (let ((sl (car (clsql:select 'subloc
591 :where [= 10 [slot-value 'subloc 'subloc-id]]
592 :flatp t :caching nil))))
594 (error "Select for modification: Found no sublocation with id = 10"))
595 (setf (slot-value sl 'title) "Altered subloc title")
596 (setf (slot-value sl 'loc) "Altered loc")
597 (clsql:update-record-from-slot sl 'title)
598 (clsql:update-record-from-slot sl 'loc)
599 (print-fresh-subloc))
600 (let ((sl (car (clsql:select 'subloc
601 :where [= 10 [slot-value 'subloc 'subloc-id]]
602 :flatp t :caching nil))))
604 (error "Select for next modification: Found no sublocation with id = 10"))
605 (setf (slot-value sl 'title) "subloc-1")
606 (setf (slot-value sl 'loc) "a subloc")
607 (clsql:update-record-from-slots sl '(title loc))
608 (print-fresh-subloc)))))
609 "10 subloc-1 a subloc"
610 "10 Altered subloc title Altered loc"
611 "10 subloc-1 a subloc")
613 ;; Verify that we can set a float to nil and then read it back
614 ;; (was failing in Postgresql at somepoint)
615 (deftest :oodml/update-records/10
616 (with-dataset *ds-employees*
617 (let ((emp (first (clsql:select 'employee :where [= [emplid] 1] :flatp t))))
618 (setf (height emp) nil)
619 (clsql-sys:update-record-from-slot emp 'height)
621 (clsql:select [height] :from [employee] :where [= [emplid] 1])
623 (setf (height emp) 42.0)
624 (clsql-sys:update-record-from-slot emp 'height)
625 (clsql:select [height] :from [employee] :where [= [emplid] 1]))
627 (setf (height emp) 24.13d0)
628 (clsql-sys:update-record-from-slot emp 'height)
629 (clsql:select [height] :from [employee] :where [= [emplid] 1])))))
634 (deftest :oodml/update-records/11
635 (with-dataset *ds-artists*
636 (clsql:update-records-from-instance artist1)
637 (list (name artist1) (artist_id artist1)))
640 (deftest :oodml/update-records/12
641 (with-dataset *ds-artists*
642 (clsql:update-records-from-instance artist1)
643 (list (name artist1) (genre artist1)))
644 ("Mogwai" "Unknown"))
646 ;; tests update-instance-from-records
647 (deftest :oodml/update-instance/1
648 (with-dataset *ds-employees*
650 (format nil "~a ~a: ~a"
651 (slot-value employee1 'first-name)
652 (slot-value employee1 'last-name)
653 (slot-value employee1 'email))
655 (clsql:update-records [employee]
656 :av-pairs '(([first-name] "Ivan")
657 ([last-name] "Petrov")
658 ([email] "petrov@soviet.org"))
659 :where [= [emplid] 1])
660 (clsql:update-instance-from-records employee1)
661 (format nil "~a ~a: ~a"
662 (slot-value employee1 'first-name)
663 (slot-value employee1 'last-name)
664 (slot-value employee1 'email)))))
665 "Vladimir Lenin: lenin@soviet.org"
666 "Ivan Petrov: petrov@soviet.org")
668 ;; tests update-slot-from-record
669 (deftest :oodml/update-instance/2
670 (with-dataset *ds-employees*
672 (slot-value employee1 'email)
674 (clsql:update-records [employee]
675 :av-pairs '(([email] "lenin-nospam@soviet.org"))
676 :where [= [emplid] 1])
677 (clsql:update-slot-from-record employee1 'email)
678 (slot-value employee1 'email))))
679 "lenin@soviet.org" "lenin-nospam@soviet.org")
681 ;; tests normalizedp update-instance-from-records
682 (deftest :oodml/update-instance/3
683 (with-dataset *ds-nodes*
685 (with-output-to-string (out)
686 (format out "~a ~a ~a ~a"
687 (slot-value theme2 'theme-id)
688 (slot-value theme2 'title)
689 (or (slot-value theme2 'vars) "NIL")
690 (slot-value theme2 'doc)))
692 (clsql:update-records [node] :av-pairs '(([title] "Altered title"))
693 :where [= [node-id] 7])
694 (clsql:update-records [setting] :av-pairs '(([vars] "Altered vars"))
695 :where [= [setting-id] 7])
696 (clsql:update-records [theme] :av-pairs '(([doc] "Altered doc"))
697 :where [= [theme-id] 7])
698 (clsql:update-instance-from-records theme2)
699 (with-output-to-string (out)
700 (format out "~a ~a ~a ~a"
701 (slot-value theme2 'theme-id)
702 (slot-value theme2 'title)
703 (slot-value theme2 'vars)
704 (slot-value theme2 'doc))))))
705 "7 theme-2 NIL second theme"
706 "7 Altered title Altered vars Altered doc")
708 (deftest :oodml/update-instance/4
709 (with-dataset *ds-nodes*
712 (setf loc2 (car (clsql:select 'location
713 :where [= [node-id] 9]
714 :flatp t :caching nil)))
716 (slot-value loc2 'node-id)
717 (slot-value loc2 'title)))
719 (clsql:update-records [node] :av-pairs '(([title] "Altered title"))
720 :where [= [node-id] 9])
721 (clsql:update-instance-from-records loc2)
723 (slot-value loc2 'node-id)
724 (slot-value loc2 'title)))))
728 (deftest :oodml/update-instance/5
729 (with-dataset *ds-nodes*
731 (format nil "~a ~a ~a"
732 (slot-value subloc2 'subloc-id)
733 (slot-value subloc2 'title)
734 (slot-value subloc2 'loc))
736 (clsql:update-records [node] :av-pairs '(([title] "Altered title"))
737 :where [= [node-id] 11])
738 (clsql:update-records [subloc] :av-pairs '(([loc] "Altered loc"))
739 :where [= [subloc-id] 11])
740 (clsql:update-instance-from-records subloc2)
741 (format nil "~a ~a ~a"
742 (slot-value subloc2 'subloc-id)
743 (slot-value subloc2 'title)
744 (slot-value subloc2 'loc)))))
745 "11 subloc-2 second subloc"
746 "11 Altered title Altered loc")
748 ;; tests update-slot-from-record with normalizedp stuff
749 (deftest :oodml/update-instance/6
750 (with-dataset *ds-nodes*
752 (slot-value theme1 'doc)
753 (slot-value theme1 'vars)
755 (clsql:update-records [theme]
756 :av-pairs '(([doc] "altered doc"))
757 :where [= [theme-id] 6])
758 (clsql:update-slot-from-record theme1 'doc)
759 (slot-value theme1 'doc))
761 (clsql:update-records [setting]
762 :av-pairs '(([vars] "altered vars"))
763 :where [= [setting-id] 6])
764 (clsql:update-slot-from-record theme1 'vars)
765 (slot-value theme1 'vars))))
766 "first theme" "empty"
767 "altered doc" "altered vars")
769 (deftest :oodml/update-instance/7
770 (flet ((print-loc (l)
772 (slot-value l 'node-id) (slot-value l 'title)))
775 (slot-value sl 'node-id) (slot-value sl 'loc))))
776 (with-dataset *ds-nodes*
779 (print-subloc subloc2)
781 (clsql:update-records [node]
782 :av-pairs '(([title] "altered title"))
783 :where [= [node-id] 9])
784 (clsql:update-slot-from-record loc2 'title)
787 (clsql:update-records [subloc]
788 :av-pairs '(([loc] "altered loc"))
789 :where [= [subloc-id] 11])
790 (clsql:update-slot-from-record subloc2 'loc)
791 (print-subloc subloc2)))))
792 "9: location-2" "11: second subloc"
793 "9: altered title" "11: altered loc")
795 (deftest :oodml/do-query/1
796 (with-dataset *ds-employees*
798 (clsql:do-query ((e) [select 'employee :order-by [emplid]])
799 (push (slot-value e 'last-name) result))
801 ("Putin" "Yeltsin" "Gorbachev" "Chernenko" "Andropov" "Brezhnev" "Kruschev"
802 "Trotsky" "Stalin" "Lenin"))
804 (deftest :oodml/do-query/2
805 (with-dataset *ds-employees*
807 (clsql:do-query ((e c) [select 'employee 'company
808 :where [= [slot-value 'employee 'last-name]
810 (push (list (slot-value e 'last-name) (slot-value c 'name))
813 (("Lenin" "Widgets Inc.")))
815 (deftest :oodml/map-query/1
816 (with-dataset *ds-employees*
817 (clsql:map-query 'list #'last-name [select 'employee :order-by [emplid]]))
818 ("Lenin" "Stalin" "Trotsky" "Kruschev" "Brezhnev" "Andropov" "Chernenko"
819 "Gorbachev" "Yeltsin" "Putin"))
821 (deftest :oodml/map-query/2
822 (with-dataset *ds-employees*
823 (clsql:map-query 'list #'(lambda (e c) (list (slot-value e 'last-name)
824 (slot-value c 'name)))
825 [select 'employee 'company :where [= [slot-value 'employee 'last-name]
827 (("Lenin" "Widgets Inc.")))
829 (deftest :oodml/iteration/3
830 (with-dataset *ds-employees*
831 (loop for (e) being the records in
832 [select 'employee :where [< [emplid] 4] :order-by [emplid]]
833 collect (slot-value e 'last-name)))
834 ("Lenin" "Stalin" "Trotsky"))
837 (deftest :oodml/cache/1
838 (with-dataset *ds-employees*
840 (setf (clsql-sys:record-caches *default-database*) nil)
841 (let ((employees (select 'employee)))
842 (every #'(lambda (a b) (eq a b))
843 employees (select 'employee)))))
846 (deftest :oodml/cache/2
847 (with-dataset *ds-employees*
848 (let ((employees (select 'employee)))
849 (equal employees (select 'employee :flatp t))))
852 (deftest :oodml/refresh/1
853 (with-dataset *ds-employees*
854 (let ((addresses (select 'address)))
855 (equal addresses (select 'address :refresh t))))
858 (deftest :oodml/refresh/2
859 (with-dataset *ds-employees*
860 (let* ((addresses (select 'address :order-by [addressid] :flatp t :refresh t))
861 (city (slot-value (car addresses) 'city)))
862 (clsql:update-records [addr]
863 :av-pairs '((city_field "A new city"))
864 :where [= [addressid] (slot-value (car addresses) 'addressid)])
865 (let* ((new-addresses (select 'address :order-by [addressid] :refresh t :flatp t))
866 (new-city (slot-value (car addresses) 'city))
868 (clsql:update-records [addr]
869 :av-pairs `((city_field ,city))
870 :where [= [addressid] (slot-value (car addresses) 'addressid)])
871 (values (equal addresses new-addresses)
874 t "Leningrad" "A new city")
876 (deftest :oodml/refresh/3
877 (with-dataset *ds-employees*
878 (let* ((addresses (select 'address :order-by [addressid] :flatp t)))
880 (equal addresses (select 'address :refresh t :flatp t))
881 (equal addresses (select 'address :flatp t)))))
884 (deftest :oodml/refresh/4
885 (with-dataset *ds-employees*
886 (let* ((addresses (select 'address :order-by [addressid] :flatp t :refresh t))
888 (make-instance 'address :addressid 1000 :city "A new address city")
889 (let ((new-addresses (select 'address :order-by [addressid] :flatp t :refresh t)))
890 (delete-records :from [addr] :where [= [addressid] 1000])
893 (length new-addresses)
894 (eq (first addresses) (first new-addresses))
895 (eq (second addresses) (second new-addresses))))))
899 (deftest :oodml/uoj/1
900 (with-dataset *ds-employees*
902 (let* ((dea-list (select 'deferred-employee-address :caching nil :order-by ["ea_join" aaddressid]
904 (dea-list-copy (copy-seq dea-list))
905 (initially-unbound (every #'(lambda (dea) (not (slot-boundp dea 'address))) dea-list)))
906 (update-objects-joins dea-list)
909 (equal dea-list dea-list-copy)
910 (every #'(lambda (dea) (slot-boundp dea 'address)) dea-list)
911 (every #'(lambda (dea) (typep (slot-value dea 'address) 'address)) dea-list)
912 (mapcar #'(lambda (dea) (slot-value (slot-value dea 'address) 'addressid)) dea-list)))))
915 ;; update-object-joins needs to be fixed for multiple keys
917 (deftest :oodml/uoj/2
919 (clsql:update-objects-joins (list company1))
920 (mapcar #'(lambda (e)
921 (slot-value e 'ecompanyid))
922 (company-employees company1)))
923 (1 1 1 1 1 1 1 1 1 1))
925 (deftest :oodml/big/1
926 (with-dataset *ds-big*
927 (let ((objs (clsql:select 'big :order-by [i] :flatp t)))
932 (rest objs (cdr rest)))
933 ((= i (length objs)) t)
934 (let ((obj (car rest))
936 (unless (and (eql (slot-value obj 'i) index)
937 (eql (slot-value obj 'bi) (truncate max index)))
943 (deftest :oodml/db-auto-sync/1
944 (with-dataset *ds-employees*
947 (make-instance 'employee :emplid 20 :groupid 1
948 :last-name "Ivanovich")
949 (select [last-name] :from [employee] :where [= [emplid] 20]
950 :flatp t :field-names nil))
951 (let ((*db-auto-sync* t))
952 (make-instance 'employee :emplid 20 :groupid 1
953 :last-name "Ivanovich")
954 (prog1 (select [last-name] :from [employee] :flatp t
956 :where [= [emplid] 20])
957 (delete-records :from [employee] :where [= [emplid] 20])))))
960 (deftest :oodml/db-auto-sync/2
961 (with-dataset *ds-employees*
963 (let ((instance (make-instance 'employee :emplid 20 :groupid 1
964 :last-name "Ivanovich")))
965 (setf (slot-value instance 'last-name) "Bulgakov")
966 (select [last-name] :from [employee] :where [= [emplid] 20]
967 :flatp t :field-names nil))
968 (let* ((*db-auto-sync* t)
969 (instance (make-instance 'employee :emplid 20 :groupid 1
970 :last-name "Ivanovich")))
971 (setf (slot-value instance 'last-name) "Bulgakov")
972 (prog1 (select [last-name] :from [employee] :flatp t
974 :where [= [emplid] 20])
975 (delete-records :from [employee] :where [= [emplid] 20])))))
978 (deftest :oodml/db-auto-sync/3
979 (with-dataset *ds-nodes*
982 (make-instance 'theme :title "test-theme" :vars "test-vars"
984 (select [node-id] :from [node] :where [= [title] "test-theme"]
985 :flatp t :field-names nil))
986 (let ((*db-auto-sync* t))
987 (make-instance 'theme :title "test-theme" :vars "test-vars"
989 (prog1 (select [title] :from [node] :where [= [title] "test-theme"]
990 :flatp t :field-names nil)
991 (delete-records :from [node] :where [= [title] "test-theme"])
992 (delete-records :from [setting] :where [= [vars] "test-vars"])
993 (delete-records :from [theme] :where [= [doc] "test-doc"])))))
996 (deftest :oodml/db-auto-sync/4
997 (with-dataset *ds-nodes*
999 (let ((inst (make-instance 'theme
1000 :title "test-theme" :vars "test-vars"
1002 (*print-circle* nil))
1003 (setf (slot-value inst 'title) "alternate-test-theme")
1004 (format nil "~a ~a ~a ~a"
1005 (or (select [title] :from [node]
1006 :where [= [title] "test-theme"]
1007 :flatp t :field-names nil) "NIL")
1008 (or (select [vars] :from [setting]
1009 :where [= [vars] "test-vars"]
1010 :flatp t :field-names nil) "NIL")
1011 (or (select [doc] :from [theme]
1012 :where [= [doc] "test-doc"]
1013 :flatp t :field-names nil) "NIL")
1014 (or (select [title] :from [node]
1015 :where [= [title] "alternate-test-theme"]
1016 :flatp t :field-names nil) "NIL")))
1017 (let* ((*db-auto-sync* t)
1018 (inst (make-instance 'theme
1019 :title "test-theme" :vars "test-vars"
1021 (setf (slot-value inst 'title) "alternate-test-theme")
1023 (format nil "~a ~a ~a ~a"
1024 (or (select [title] :from [node]
1025 :where [= [title] "test-theme"]
1026 :flatp t :field-names nil) "NIL")
1027 (or (select [vars] :from [setting]
1028 :where [= [vars] "test-vars"]
1029 :flatp t :field-names nil) "NIL")
1030 (or (select [doc] :from [theme]
1031 :where [= [doc] "test-doc"]
1032 :flatp t :field-names nil) "NIL")
1033 (or (select [title] :from [node]
1034 :where [= [title] "alternate-test-theme"]
1035 :flatp t :field-names nil) "NIL"))
1036 (delete-records :from [node] :where [= [title] "alternate-test-theme"])
1037 (delete-records :from [setting] :where [= [vars] "test-vars"])
1038 (delete-records :from [theme] :where [= [doc] "test-doc"])))))
1040 "NIL (test-vars) (test-doc) (alternate-test-theme)")
1042 (deftest :oodml/setf-slot-value/1
1043 (with-dataset *ds-employees*
1044 (let* ((*db-auto-sync* t)
1045 (instance (make-instance 'employee :emplid 20 :groupid 1)))
1048 (slot-value instance 'first-name) "Mikhail"
1049 (slot-value instance 'last-name) "Bulgakov")
1050 (delete-records :from [employee] :where [= [emplid] 20]))))
1053 (deftest :oodml/float/1
1054 (with-dataset *ds-employees*
1055 (let* ((emp1 (car (select 'employee
1056 :where [= [slot-value 'employee 'emplid]
1060 (height (slot-value emp1 'height)))
1063 (setf (slot-value emp1 'height) 1.0E0)
1064 (clsql:update-record-from-slot emp1 'height)
1065 (= (car (clsql:select [height] :from [employee]
1066 :where [= [emplid] 1]
1070 (setf (slot-value emp1 'height) height)
1071 (clsql:update-record-from-slot emp1 'height))))
1074 (deftest :oodml/float/2
1075 (with-dataset *ds-employees*
1076 (let* ((emp1 (car (select 'employee
1077 :where [= [slot-value 'employee 'emplid]
1081 (height (slot-value emp1 'height)))
1084 (setf (slot-value emp1 'height) 1.0S0)
1085 (clsql:update-record-from-slot emp1 'height)
1086 (= (car (clsql:select [height] :from [employee]
1087 :where [= [emplid] 1]
1091 (setf (slot-value emp1 'height) height)
1092 (clsql:update-record-from-slot emp1 'height))))
1095 (deftest :oodml/float/3
1096 (with-dataset *ds-employees*
1097 (let* ((emp1 (car (select 'employee
1098 :where [= [slot-value 'employee 'emplid]
1102 (height (slot-value emp1 'height)))
1105 (setf (slot-value emp1 'height) 1.0F0)
1106 (clsql:update-record-from-slot emp1 'height)
1107 (= (car (clsql:select [height] :from [employee]
1108 :where [= [emplid] 1]
1112 (setf (slot-value emp1 'height) height)
1113 (clsql:update-record-from-slot emp1 'height))))
1116 (deftest :oodml/float/4
1117 (with-dataset *ds-employees*
1118 (let* ((emp1 (car (select 'employee
1119 :where [= [slot-value 'employee 'emplid]
1123 (height (slot-value emp1 'height)))
1126 (setf (slot-value emp1 'height) 1.0D0)
1127 (clsql:update-record-from-slot emp1 'height)
1128 (= (car (clsql:select [height] :from [employee]
1129 :where [= [emplid] 1]
1133 (setf (slot-value emp1 'height) height)
1134 (clsql:update-record-from-slot emp1 'height))))
1137 (deftest :oodml/float/5
1138 (with-dataset *ds-employees*
1139 (let* ((emp1 (car (select 'employee
1140 :where [= [slot-value 'employee 'emplid]
1144 (height (slot-value emp1 'height)))
1147 (setf (slot-value emp1 'height) 1.0L0)
1148 (clsql:update-record-from-slot emp1 'height)
1149 (= (car (clsql:select [height] :from [employee]
1150 :where [= [emplid] 1]
1154 (setf (slot-value emp1 'height) height)
1155 (clsql:update-record-from-slot emp1 'height))))