1 ;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
2 ;;;; ======================================================================
3 ;;;; File: test-oodml.lisp
4 ;;;; Author: Marcus Pearce <m.t.pearce@city.ac.uk>
5 ;;;; Created: 01/04/2004
7 ;;;; Tests for the CLSQL Object Oriented Data Definition Language
10 ;;;; This file is part of CLSQL.
12 ;;;; CLSQL users are granted the rights to distribute and use this software
13 ;;;; as governed by the terms of the Lisp Lesser GNU Public License
14 ;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL.
15 ;;;; ======================================================================
17 (in-package #:clsql-tests)
19 #.(clsql:locally-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 [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 [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 [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 [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 [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 ;; test retrieval is deferred
216 (deftest :oodm/retrieval/1
217 (with-dataset *ds-employees*
218 (every #'(lambda (e) (not (slot-boundp e 'company)))
219 (select 'employee :flatp t :caching nil)))
222 (deftest :oodm/retrieval/2
223 (with-dataset *ds-employees*
224 (every #'(lambda (e) (not (slot-boundp e 'address)))
225 (select 'deferred-employee-address :flatp t :caching nil)))
228 ;; :retrieval :immediate should be boundp before accessed
229 (deftest :oodm/retrieval/3
230 (with-dataset *ds-employees*
231 (every #'(lambda (ea) (slot-boundp ea 'address))
232 (select 'employee-address :flatp t :caching nil)))
235 (deftest :oodm/retrieval/4
236 (with-dataset *ds-employees*
237 (mapcar #'(lambda (ea) (typep (slot-value ea 'address) 'address))
238 (select 'employee-address :flatp t :caching nil)))
241 (deftest :oodm/retrieval/5
242 (with-dataset *ds-employees*
243 (mapcar #'(lambda (ea) (typep (slot-value ea 'address) 'address))
244 (select 'deferred-employee-address :flatp t :caching nil)))
247 (deftest :oodm/retrieval/6
248 (with-dataset *ds-employees*
249 (every #'(lambda (ea) (slot-boundp (slot-value ea 'address) 'addressid))
250 (select 'employee-address :flatp t :caching nil)))
253 (deftest :oodm/retrieval/7
254 (with-dataset *ds-employees*
255 (every #'(lambda (ea) (slot-boundp (slot-value ea 'address) 'addressid))
256 (select 'deferred-employee-address :flatp t :caching nil)))
259 (deftest :oodm/retrieval/8
260 (with-dataset *ds-employees*
261 (mapcar #'(lambda (ea) (slot-value (slot-value ea 'address) 'street-number))
262 (select 'employee-address :flatp t :order-by [aaddressid] :caching nil)))
265 (deftest :oodm/retrieval/9
266 (with-dataset *ds-employees*
267 (mapcar #'(lambda (ea) (slot-value (slot-value ea 'address) 'street-number))
268 (select 'deferred-employee-address :flatp t :order-by [aaddressid] :caching nil)))
271 ;; tests update-records-from-instance
272 (deftest :oodml/update-records/1
273 (with-dataset *ds-employees*
276 (let ((lenin (car (clsql:select 'employee
277 :where [= 1 [slot-value 'employee 'emplid]]
280 (format nil "~a ~a: ~a"
283 (employee-email lenin))))
285 (setf (slot-value employee1 'first-name) "Dimitriy"
286 (slot-value employee1 'last-name) "Ivanovich"
287 (slot-value employee1 'email) "ivanovich@soviet.org")
288 (clsql:update-records-from-instance employee1)
289 (let ((lenin (car (clsql:select 'employee
290 :where [= 1 [slot-value 'employee 'emplid]]
293 (format nil "~a ~a: ~a"
296 (employee-email lenin))))))
297 "Vladimir Lenin: lenin@soviet.org"
298 "Dimitriy Ivanovich: ivanovich@soviet.org")
300 ;; tests update-record-from-slot
301 (deftest :oodml/update-records/2
302 (with-dataset *ds-employees*
305 (car (clsql:select 'employee
306 :where [= 1 [slot-value 'employee 'emplid]]
310 (setf (slot-value employee1 'email) "lenin-nospam@soviet.org")
311 (clsql:update-record-from-slot employee1 'email)
313 (car (clsql:select 'employee
314 :where [= 1 [slot-value 'employee 'emplid]]
317 "lenin@soviet.org" "lenin-nospam@soviet.org")
319 ;; tests update-record-from-slots
320 (deftest :oodml/update-records/3
321 (with-dataset *ds-employees*
323 (let ((lenin (car (clsql:select 'employee
324 :where [= 1 [slot-value 'employee 'emplid]]
327 (format nil "~a ~a: ~a"
330 (employee-email lenin)))
332 (setf (slot-value employee1 'first-name) "Dimitriy"
333 (slot-value employee1 'last-name) "Ivanovich"
334 (slot-value employee1 'email) "ivanovich@soviet.org")
335 (clsql:update-record-from-slots employee1 '(first-name last-name email))
336 (let ((lenin (car (clsql:select 'employee
337 :where [= 1 [slot-value 'employee 'emplid]]
340 (format nil "~a ~a: ~a"
343 (employee-email lenin))))))
344 "Vladimir Lenin: lenin@soviet.org"
345 "Dimitriy Ivanovich: ivanovich@soviet.org")
347 (deftest :oodml/update-records/4
348 (with-dataset *ds-nodes*
349 (flet ((print-fresh-node ()
350 (let ((base (car (clsql:select 'node
351 :where [= 1 [slot-value 'node 'node-id]]
352 :flatp t :caching nil))))
354 (slot-value base 'node-id)
355 (slot-value base 'title)))))
358 (let ((base (car (clsql:select 'node
359 :where [= 1 [slot-value 'node 'node-id]]
360 :flatp t :caching nil))))
361 (setf (slot-value base 'title) "Altered title")
362 (clsql:update-records-from-instance base)
363 (print-fresh-node)))))
367 (deftest :oodml/update-records/4-slots ;just like 4, but use slots fns.
368 (with-dataset *ds-nodes*
369 (flet ((print-fresh-setting ()
370 (let ((node (car (clsql:select 'setting
371 :where [= 3 [slot-value 'setting 'setting-id]]
372 :flatp t :caching nil))))
373 (format nil "~a ~a ~a"
374 (slot-value node 'setting-id)
375 (slot-value node 'title)
376 (slot-value node 'vars)))))
378 (print-fresh-setting)
379 (let ((node (car (clsql:select 'setting
380 :where [= 3 [slot-value 'setting 'setting-id]]
381 :flatp t :caching nil))))
382 (setf (slot-value node 'title) "Altered title")
383 (setf (slot-value node 'vars) "Altered vars")
384 (clsql-sys:update-record-from-slot node 'title)
385 (clsql-sys:update-record-from-slot 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) "Setting2")
391 (setf (slot-value node 'vars) "var 2")
392 (clsql:update-records-from-instance node)
393 (clsql-sys:update-record-from-slots node '(vars title))
394 (print-fresh-setting)))))
396 "3 Altered title Altered vars"
399 (deftest :oodml/update-records/5
400 (with-dataset *ds-nodes*
401 (flet ((print-fresh-setting ()
402 (let ((node (car (clsql:select 'setting
403 :where [= 3 [slot-value 'setting 'setting-id]]
404 :flatp t :caching nil))))
405 (format nil "~a ~a ~a"
406 (slot-value node 'setting-id)
407 (slot-value node 'title)
408 (slot-value node 'vars)))))
410 (print-fresh-setting)
411 (let ((node (car (clsql:select 'setting
412 :where [= 3 [slot-value 'setting 'setting-id]]
413 :flatp t :caching nil))))
414 (setf (slot-value node 'title) "Altered title")
415 (setf (slot-value node 'vars) "Altered vars")
416 (clsql:update-records-from-instance node)
417 (print-fresh-setting)))))
419 "3 Altered title Altered vars")
421 (deftest :oodml/update-records/5-slots
422 (with-dataset *ds-nodes*
423 (flet ((print-fresh-setting ()
424 (let ((node (car (clsql:select 'setting
425 :where [= 3 [slot-value 'setting 'setting-id]]
426 :flatp t :caching nil))))
427 (format nil "~a ~a ~a"
428 (slot-value node 'setting-id)
429 (slot-value node 'title)
430 (slot-value node 'vars)))))
432 (print-fresh-setting)
433 (let ((node (car (clsql:select 'setting
434 :where [= 3 [slot-value 'setting 'setting-id]]
435 :flatp t :caching nil))))
436 (setf (slot-value node 'title) "Altered title")
437 (setf (slot-value node 'vars) "Altered vars")
438 (clsql-sys:update-record-from-slot node 'title)
439 (clsql-sys:update-record-from-slot 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) "Setting2")
445 (setf (slot-value node 'vars) "var 2")
446 (clsql-sys:update-record-from-slots node '(title vars))
447 (print-fresh-setting)))))
449 "3 Altered title Altered vars"
452 (deftest :oodml/update-records/6
453 (with-dataset *ds-nodes*
454 (flet ((print-fresh-setting ()
455 (let ((node (car (clsql:select 'setting
456 :where [= 7 [slot-value 'setting 'setting-id]]
457 :flatp t :caching nil))))
458 (format nil "~a ~a ~a"
459 (slot-value node 'setting-id)
460 (slot-value node 'title)
461 (slot-value node 'vars)))))
463 (print-fresh-setting)
464 (let ((node (car (clsql:select 'setting
465 :where [= 7 [slot-value 'setting 'setting-id]]
466 :flatp t :caching nil))))
467 (setf (slot-value node 'title) "Altered title")
468 (setf (slot-value node 'vars) "Altered vars")
469 (clsql:update-records-from-instance node)
470 (print-fresh-setting))
471 (let ((node (car (clsql:select 'setting
472 :where [= 7 [slot-value 'setting 'setting-id]]
473 :flatp t :caching nil))))
474 (setf (slot-value node 'title) "theme-2")
475 (setf (slot-value node 'vars) nil)
476 (clsql:update-records-from-instance node)
477 (print-fresh-setting)))))
479 "7 Altered title Altered vars"
482 (deftest :oodml/update-records/7
483 (with-dataset *ds-nodes*
484 (flet ((print-fresh-user ()
485 "requery to get what the db has, and print out."
486 (let ((node (car (clsql:select 'user
487 :where [= 5 [slot-value 'user 'user-id]]
488 :flatp t :caching nil))))
489 (format nil "~a ~a ~a"
490 (slot-value node 'user-id)
491 (slot-value node 'title)
492 (slot-value node 'nick)))))
495 (let ((node (car (clsql:select 'user
496 :where [= 5 [slot-value 'user 'user-id]]
497 :flatp t :caching nil))))
498 (setf (slot-value node 'title) "Altered title")
499 (setf (slot-value node 'nick) "Altered nick")
500 (clsql:update-records-from-instance node)
501 (print-fresh-user)))))
502 "5 user-2 second user"
503 "5 Altered title Altered nick")
505 (deftest :oodml/update-records/8
506 (with-dataset *ds-nodes*
507 (flet ((print-fresh-theme ()
508 (let ((node (car (clsql:select 'theme
509 :where [= 6 [slot-value 'theme 'theme-id]]
510 :flatp t :caching nil))))
511 (with-slots (node-id setting-id theme-id title vars doc) node
512 (format nil "~a ~a ~a ~a ~a ~a"
513 node-id setting-id theme-id
517 (let ((node (car (clsql:select 'setting
518 :where [= 6 [slot-value 'setting 'setting-id]]
519 :flatp t :caching nil))))
520 (setf (slot-value node 'title) "Altered title")
521 (setf (slot-value node 'vars) nil)
522 (clsql:update-records-from-instance node)
524 (let ((node (car (clsql:select 'theme
525 :where [= 6 [slot-value 'theme 'theme-id]]
526 :flatp t :caching nil))))
527 (setf (slot-value node 'title) "Altered title again")
528 (setf (slot-value node 'doc) "altered doc")
529 (clsql:update-records-from-instance node)
531 (let ((node (car (clsql:select 'theme
532 :where [= 6 [slot-value 'theme 'theme-id]]
533 :flatp t :caching nil))))
534 (setf (slot-value node 'title) "theme-1")
535 (setf (slot-value node 'vars) "empty")
536 (setf (slot-value node 'doc) "first theme")
537 (clsql:update-records-from-instance node)
538 (print-fresh-theme)))))
539 "6 6 6 theme-1 empty first theme"
540 "6 6 6 Altered title NIL first theme"
541 "6 6 6 Altered title again NIL altered doc"
542 "6 6 6 theme-1 empty first theme")
544 (deftest :oodml/update-records/9
545 (with-dataset *ds-nodes*
546 (flet ((print-fresh-subloc ()
547 (let ((sl (car (clsql:select 'subloc
548 :where [= 10 [slot-value 'subloc 'subloc-id]]
549 :flatp t :caching nil))))
550 (format nil "~a ~a ~a"
551 (slot-value sl 'subloc-id)
552 (slot-value sl 'title)
553 (slot-value sl 'loc)))))
556 (let ((sl (car (clsql:select 'subloc
557 :where [= 10 [slot-value 'subloc 'subloc-id]]
558 :flatp t :caching nil))))
559 (setf (slot-value sl 'title) "Altered subloc title")
560 (setf (slot-value sl 'loc) "Altered loc")
561 (clsql:update-records-from-instance sl)
562 (print-fresh-subloc)))))
563 "10 subloc-1 a subloc"
564 "10 Altered subloc title Altered loc")
566 (deftest :oodml/update-records/9-slots ;like 9, but use slots fns.
567 (with-dataset *ds-nodes*
568 (flet ((print-fresh-subloc ()
569 (let ((sl (car (clsql:select 'subloc
570 :where [= 10 [slot-value 'subloc 'subloc-id]]
571 :flatp t :caching nil))))
572 (format nil "~a ~a ~a"
573 (slot-value sl 'subloc-id)
574 (slot-value sl 'title)
575 (slot-value sl 'loc)))))
578 (let ((sl (car (clsql:select 'subloc
579 :where [= 10 [slot-value 'subloc 'subloc-id]]
580 :flatp t :caching nil))))
581 (setf (slot-value sl 'title) "Altered subloc title")
582 (setf (slot-value sl 'loc) "Altered loc")
583 (clsql:update-record-from-slot sl 'title)
584 (clsql:update-record-from-slot sl 'loc)
585 (print-fresh-subloc))
586 (let ((sl (car (clsql:select 'subloc
587 :where [= 10 [slot-value 'subloc 'subloc-id]]
588 :flatp t :caching nil))))
589 (setf (slot-value sl 'title) "subloc-1")
590 (setf (slot-value sl 'loc) "a subloc")
591 (clsql:update-record-from-slot sl '(title loc))
592 (print-fresh-subloc)))))
593 "10 subloc-1 a subloc"
594 "10 Altered subloc title Altered loc"
595 "10 subloc-1 a subloc")
597 ;; Verify that we can set a float to nil and then read it back
598 ;; (was failing in Postgresql at somepoint)
599 (deftest :oodml/update-records/10
600 (with-dataset *ds-employees*
601 (let ((emp (first (clsql:select 'employee :where [= [emplid] 1] :flatp T))))
602 (setf (height emp) nil)
603 (clsql-sys:update-record-from-slot emp 'height)
605 (clsql:select [height] :from [employee] :where [= [emplid] 1])
607 (setf (height emp) 42.0)
608 (clsql-sys:update-record-from-slot emp 'height)
609 (clsql:select [height] :from [employee] :where [= [emplid] 1]))
611 (setf (height emp) 24.13d0)
612 (clsql-sys:update-record-from-slot emp 'height)
613 (clsql:select [height] :from [employee] :where [= [emplid] 1])))))
619 ;; tests update-instance-from-records
620 (deftest :oodml/update-instance/1
621 (with-dataset *ds-employees*
623 (format nil "~a ~a: ~a"
624 (slot-value employee1 'first-name)
625 (slot-value employee1 'last-name)
626 (slot-value employee1 'email))
628 (clsql:update-records [employee]
629 :av-pairs '(([first-name] "Ivan")
630 ([last-name] "Petrov")
631 ([email] "petrov@soviet.org"))
632 :where [= [emplid] 1])
633 (clsql:update-instance-from-records employee1)
634 (format nil "~a ~a: ~a"
635 (slot-value employee1 'first-name)
636 (slot-value employee1 'last-name)
637 (slot-value employee1 'email)))))
638 "Vladimir Lenin: lenin@soviet.org"
639 "Ivan Petrov: petrov@soviet.org")
641 ;; tests update-slot-from-record
642 (deftest :oodml/update-instance/2
643 (with-dataset *ds-employees*
645 (slot-value employee1 'email)
647 (clsql:update-records [employee]
648 :av-pairs '(([email] "lenin-nospam@soviet.org"))
649 :where [= [emplid] 1])
650 (clsql:update-slot-from-record employee1 'email)
651 (slot-value employee1 'email))))
652 "lenin@soviet.org" "lenin-nospam@soviet.org")
654 ;; tests normalizedp update-instance-from-records
655 (deftest :oodml/update-instance/3
656 (with-dataset *ds-nodes*
658 (with-output-to-string (out)
659 (format out "~a ~a ~a ~a"
660 (slot-value theme2 'theme-id)
661 (slot-value theme2 'title)
662 (slot-value theme2 'vars)
663 (slot-value theme2 'doc)))
665 (clsql:update-records [node] :av-pairs '(([title] "Altered title"))
666 :where [= [node-id] 7])
667 (clsql:update-records [setting] :av-pairs '(([vars] "Altered vars"))
668 :where [= [setting-id] 7])
669 (clsql:update-records [theme] :av-pairs '(([doc] "Altered doc"))
670 :where [= [theme-id] 7])
671 (clsql:update-instance-from-records theme2)
672 (with-output-to-string (out)
673 (format out "~a ~a ~a ~a"
674 (slot-value theme2 'theme-id)
675 (slot-value theme2 'title)
676 (slot-value theme2 'vars)
677 (slot-value theme2 'doc))))))
678 "7 theme-2 NIL second theme"
679 "7 Altered title Altered vars Altered doc")
681 (deftest :oodml/update-instance/4
682 (with-dataset *ds-nodes*
685 (setf loc2 (car (clsql:select 'location
686 :where [= [node-id] 9]
687 :flatp t :caching nil)))
689 (slot-value loc2 'node-id)
690 (slot-value loc2 'title)))
692 (clsql:update-records [node] :av-pairs '(([title] "Altered title"))
693 :where [= [node-id] 9])
694 (clsql:update-instance-from-records loc2)
696 (slot-value loc2 'node-id)
697 (slot-value loc2 'title)))))
701 (deftest :oodml/update-instance/5
702 (with-dataset *ds-nodes*
704 (format nil "~a ~a ~a"
705 (slot-value subloc2 'subloc-id)
706 (slot-value subloc2 'title)
707 (slot-value subloc2 'loc))
709 (clsql:update-records [node] :av-pairs '(([title] "Altered title"))
710 :where [= [node-id] 11])
711 (clsql:update-records [subloc] :av-pairs '(([loc] "Altered loc"))
712 :where [= [subloc-id] 11])
713 (clsql:update-instance-from-records subloc2)
714 (format nil "~a ~a ~a"
715 (slot-value subloc2 'subloc-id)
716 (slot-value subloc2 'title)
717 (slot-value subloc2 'loc)))))
718 "11 subloc-2 second subloc"
719 "11 Altered title Altered loc")
721 ;; tests update-slot-from-record with normalizedp stuff
722 (deftest :oodml/update-instance/6
723 (with-dataset *ds-nodes*
725 (slot-value theme1 'doc)
726 (slot-value theme1 'vars)
728 (clsql:update-records [theme]
729 :av-pairs '(([doc] "altered doc"))
730 :where [= [theme-id] 6])
731 (clsql:update-slot-from-record theme1 'doc)
732 (slot-value theme1 'doc))
734 (clsql:update-records [setting]
735 :av-pairs '(([vars] "altered vars"))
736 :where [= [setting-id] 6])
737 (clsql:update-slot-from-record theme1 'vars)
738 (slot-value theme1 'vars))))
739 "first theme" "empty"
740 "altered doc" "altered vars")
742 (deftest :oodml/update-instance/7
743 (flet ((print-loc (l)
745 (slot-value l 'node-id) (slot-value l 'title)))
748 (slot-value sl 'node-id) (slot-value sl 'loc))))
749 (with-dataset *ds-nodes*
752 (print-subloc subloc2)
754 (clsql:update-records [node]
755 :av-pairs '(([title] "altered title"))
756 :where [= [node-id] 9])
757 (clsql:update-slot-from-record loc2 'title)
760 (clsql:update-records [subloc]
761 :av-pairs '(([loc] "altered loc"))
762 :where [= [subloc-id] 11])
763 (clsql:update-slot-from-record subloc2 'loc)
764 (print-subloc subloc2)))))
765 "9: location-2" "11: second subloc"
766 "9: altered title" "11: altered loc")
768 (deftest :oodml/do-query/1
769 (with-dataset *ds-employees*
771 (clsql:do-query ((e) [select 'employee :order-by [emplid]])
772 (push (slot-value e 'last-name) result))
774 ("Putin" "Yeltsin" "Gorbachev" "Chernenko" "Andropov" "Brezhnev" "Kruschev"
775 "Trotsky" "Stalin" "Lenin"))
777 (deftest :oodml/do-query/2
778 (with-dataset *ds-employees*
780 (clsql:do-query ((e c) [select 'employee 'company
781 :where [= [slot-value 'employee 'last-name]
783 (push (list (slot-value e 'last-name) (slot-value c 'name))
786 (("Lenin" "Widgets Inc.")))
788 (deftest :oodml/map-query/1
789 (with-dataset *ds-employees*
790 (clsql:map-query 'list #'last-name [select 'employee :order-by [emplid]]))
791 ("Lenin" "Stalin" "Trotsky" "Kruschev" "Brezhnev" "Andropov" "Chernenko"
792 "Gorbachev" "Yeltsin" "Putin"))
794 (deftest :oodml/map-query/2
795 (with-dataset *ds-employees*
796 (clsql:map-query 'list #'(lambda (e c) (list (slot-value e 'last-name)
797 (slot-value c 'name)))
798 [select 'employee 'company :where [= [slot-value 'employee 'last-name]
800 (("Lenin" "Widgets Inc.")))
802 (deftest :oodml/iteration/3
803 (with-dataset *ds-employees*
804 (loop for (e) being the records in
805 [select 'employee :where [< [emplid] 4] :order-by [emplid]]
806 collect (slot-value e 'last-name)))
807 ("Lenin" "Stalin" "Trotsky"))
810 (deftest :oodml/cache/1
811 (with-dataset *ds-employees*
813 (setf (clsql-sys:record-caches *default-database*) nil)
814 (let ((employees (select 'employee)))
815 (every #'(lambda (a b) (eq a b))
816 employees (select 'employee)))))
819 (deftest :oodml/cache/2
820 (with-dataset *ds-employees*
821 (let ((employees (select 'employee)))
822 (equal employees (select 'employee :flatp t))))
825 (deftest :oodml/refresh/1
826 (with-dataset *ds-employees*
827 (let ((addresses (select 'address)))
828 (equal addresses (select 'address :refresh t))))
831 (deftest :oodml/refresh/2
832 (with-dataset *ds-employees*
833 (let* ((addresses (select 'address :order-by [addressid] :flatp t :refresh t))
834 (city (slot-value (car addresses) 'city)))
835 (clsql:update-records [addr]
836 :av-pairs '((city_field "A new city"))
837 :where [= [addressid] (slot-value (car addresses) 'addressid)])
838 (let* ((new-addresses (select 'address :order-by [addressid] :refresh t :flatp t))
839 (new-city (slot-value (car addresses) 'city))
841 (clsql:update-records [addr]
842 :av-pairs `((city_field ,city))
843 :where [= [addressid] (slot-value (car addresses) 'addressid)])
844 (values (equal addresses new-addresses)
847 t "Leningrad" "A new city")
849 (deftest :oodml/refresh/3
850 (with-dataset *ds-employees*
851 (let* ((addresses (select 'address :order-by [addressid] :flatp t)))
853 (equal addresses (select 'address :refresh t :flatp t))
854 (equal addresses (select 'address :flatp t)))))
857 (deftest :oodml/refresh/4
858 (with-dataset *ds-employees*
859 (let* ((addresses (select 'address :order-by [addressid] :flatp t :refresh t))
861 (make-instance 'address :addressid 1000 :city "A new address city")
862 (let ((new-addresses (select 'address :order-by [addressid] :flatp t :refresh t)))
863 (delete-records :from [addr] :where [= [addressid] 1000])
866 (length new-addresses)
867 (eq (first addresses) (first new-addresses))
868 (eq (second addresses) (second new-addresses))))))
872 (deftest :oodml/uoj/1
873 (with-dataset *ds-employees*
875 (let* ((dea-list (select 'deferred-employee-address :caching nil :order-by ["ea_join" aaddressid]
877 (dea-list-copy (copy-seq dea-list))
878 (initially-unbound (every #'(lambda (dea) (not (slot-boundp dea 'address))) dea-list)))
879 (update-objects-joins dea-list)
882 (equal dea-list dea-list-copy)
883 (every #'(lambda (dea) (slot-boundp dea 'address)) dea-list)
884 (every #'(lambda (dea) (typep (slot-value dea 'address) 'address)) dea-list)
885 (mapcar #'(lambda (dea) (slot-value (slot-value dea 'address) 'addressid)) dea-list)))))
888 ;; update-object-joins needs to be fixed for multiple keys
890 (deftest :oodml/uoj/2
892 (clsql:update-objects-joins (list company1))
893 (mapcar #'(lambda (e)
894 (slot-value e 'ecompanyid))
895 (company-employees company1)))
896 (1 1 1 1 1 1 1 1 1 1))
898 (deftest :oodml/big/1
899 (with-dataset *ds-big*
900 (let ((objs (clsql:select 'big :order-by [i] :flatp t)))
905 (rest objs (cdr rest)))
906 ((= i (length objs)) t)
907 (let ((obj (car rest))
909 (unless (and (eql (slot-value obj 'i) index)
910 (eql (slot-value obj 'bi) (truncate max index)))
916 (deftest :oodml/db-auto-sync/1
917 (with-dataset *ds-employees*
920 (make-instance 'employee :emplid 20 :groupid 1
921 :last-name "Ivanovich")
922 (select [last-name] :from [employee] :where [= [emplid] 20]
923 :flatp t :field-names nil))
924 (let ((*db-auto-sync* t))
925 (make-instance 'employee :emplid 20 :groupid 1
926 :last-name "Ivanovich")
927 (prog1 (select [last-name] :from [employee] :flatp t
929 :where [= [emplid] 20])
930 (delete-records :from [employee] :where [= [emplid] 20])))))
933 (deftest :oodml/db-auto-sync/2
934 (with-dataset *ds-employees*
936 (let ((instance (make-instance 'employee :emplid 20 :groupid 1
937 :last-name "Ivanovich")))
938 (setf (slot-value instance 'last-name) "Bulgakov")
939 (select [last-name] :from [employee] :where [= [emplid] 20]
940 :flatp t :field-names nil))
941 (let* ((*db-auto-sync* t)
942 (instance (make-instance 'employee :emplid 20 :groupid 1
943 :last-name "Ivanovich")))
944 (setf (slot-value instance 'last-name) "Bulgakov")
945 (prog1 (select [last-name] :from [employee] :flatp t
947 :where [= [emplid] 20])
948 (delete-records :from [employee] :where [= [emplid] 20])))))
951 (deftest :oodml/db-auto-sync/3
952 (with-dataset *ds-nodes*
955 (make-instance 'theme :title "test-theme" :vars "test-vars"
957 (select [node-id] :from [node] :where [= [title] "test-theme"]
958 :flatp t :field-names nil))
959 (let ((*db-auto-sync* t))
960 (make-instance 'theme :title "test-theme" :vars "test-vars"
962 (prog1 (select [title] :from [node] :where [= [title] "test-theme"]
963 :flatp t :field-names nil)
964 (delete-records :from [node] :where [= [title] "test-theme"])
965 (delete-records :from [setting] :where [= [vars] "test-vars"])
966 (delete-records :from [theme] :where [= [doc] "test-doc"])))))
969 (deftest :oodml/db-auto-sync/4
970 (with-dataset *ds-nodes*
972 (let ((inst (make-instance 'theme
973 :title "test-theme" :vars "test-vars"
975 (setf (slot-value inst 'title) "alternate-test-theme")
976 (format nil "~a ~a ~a ~a"
977 (select [title] :from [node]
978 :where [= [title] "test-theme"]
979 :flatp t :field-names nil)
980 (select [vars] :from [setting]
981 :where [= [vars] "test-vars"]
982 :flatp t :field-names nil)
983 (select [doc] :from [theme]
984 :where [= [doc] "test-doc"]
985 :flatp t :field-names nil)
986 (select [title] :from [node]
987 :where [= [title] "alternate-test-theme"]
988 :flatp t :field-names nil)))
989 (let* ((*db-auto-sync* t)
990 (inst (make-instance 'theme
991 :title "test-theme" :vars "test-vars"
993 (setf (slot-value inst 'title) "alternate-test-theme")
995 (format nil "~a ~a ~a ~a"
996 (select [title] :from [node]
997 :where [= [title] "test-theme"]
998 :flatp t :field-names nil)
999 (select [vars] :from [setting]
1000 :where [= [vars] "test-vars"]
1001 :flatp t :field-names nil)
1002 (select [doc] :from [theme]
1003 :where [= [doc] "test-doc"]
1004 :flatp t :field-names nil)
1005 (select [title] :from [node]
1006 :where [= [title] "alternate-test-theme"]
1007 :flatp t :field-names nil))
1008 (delete-records :from [node] :where [= [title] "alternate-test-theme"])
1009 (delete-records :from [setting] :where [= [vars] "test-vars"])
1010 (delete-records :from [theme] :where [= [doc] "test-doc"])))))
1012 "NIL (test-vars) (test-doc) (alternate-test-theme)")
1014 (deftest :oodml/setf-slot-value/1
1015 (with-dataset *ds-employees*
1016 (let* ((*db-auto-sync* t)
1017 (instance (make-instance 'employee :emplid 20 :groupid 1)))
1020 (slot-value instance 'first-name) "Mikhail"
1021 (slot-value instance 'last-name) "Bulgakov")
1022 (delete-records :from [employee] :where [= [emplid] 20]))))
1025 (deftest :oodml/float/1
1026 (with-dataset *ds-employees*
1027 (let* ((emp1 (car (select 'employee
1028 :where [= [slot-value 'employee 'emplid]
1032 (height (slot-value emp1 'height)))
1035 (setf (slot-value emp1 'height) 1.0E0)
1036 (clsql:update-record-from-slot emp1 'height)
1037 (= (car (clsql:select [height] :from [employee]
1038 :where [= [emplid] 1]
1042 (setf (slot-value emp1 'height) height)
1043 (clsql:update-record-from-slot emp1 'height))))
1046 (deftest :oodml/float/2
1047 (with-dataset *ds-employees*
1048 (let* ((emp1 (car (select 'employee
1049 :where [= [slot-value 'employee 'emplid]
1053 (height (slot-value emp1 'height)))
1056 (setf (slot-value emp1 'height) 1.0S0)
1057 (clsql:update-record-from-slot emp1 'height)
1058 (= (car (clsql:select [height] :from [employee]
1059 :where [= [emplid] 1]
1063 (setf (slot-value emp1 'height) height)
1064 (clsql:update-record-from-slot emp1 'height))))
1067 (deftest :oodml/float/3
1068 (with-dataset *ds-employees*
1069 (let* ((emp1 (car (select 'employee
1070 :where [= [slot-value 'employee 'emplid]
1074 (height (slot-value emp1 'height)))
1077 (setf (slot-value emp1 'height) 1.0F0)
1078 (clsql:update-record-from-slot emp1 'height)
1079 (= (car (clsql:select [height] :from [employee]
1080 :where [= [emplid] 1]
1084 (setf (slot-value emp1 'height) height)
1085 (clsql:update-record-from-slot emp1 'height))))
1088 (deftest :oodml/float/4
1089 (with-dataset *ds-employees*
1090 (let* ((emp1 (car (select 'employee
1091 :where [= [slot-value 'employee 'emplid]
1095 (height (slot-value emp1 'height)))
1098 (setf (slot-value emp1 'height) 1.0D0)
1099 (clsql:update-record-from-slot emp1 'height)
1100 (= (car (clsql:select [height] :from [employee]
1101 :where [= [emplid] 1]
1105 (setf (slot-value emp1 'height) height)
1106 (clsql:update-record-from-slot emp1 'height))))
1109 (deftest :oodml/float/5
1110 (with-dataset *ds-employees*
1111 (let* ((emp1 (car (select 'employee
1112 :where [= [slot-value 'employee 'emplid]
1116 (height (slot-value emp1 'height)))
1119 (setf (slot-value emp1 'height) 1.0L0)
1120 (clsql:update-record-from-slot emp1 'height)
1121 (= (car (clsql:select [height] :from [employee]
1122 :where [= [emplid] 1]
1126 (setf (slot-value emp1 'height) height)
1127 (clsql:update-record-from-slot emp1 'height))))
1133 #.(clsql:restore-sql-reader-syntax-state)