3 ;;;; CREATE USER rofl_test PASSWORD 'rofl_test';
4 ;;;; CREATE DATABASE rofl_test OWNER rofl_test;
7 (defmacro db
(&body body
)
8 `(postmodern:with-connection
'("rofl_test" "rofl_test" "rofl_test" "localhost")
11 (deftest test-create-table
()
13 (postmodern:query
(:DROP-TABLE
'rofl_test_base
))
15 (postmodern:query
(:CREATE-TABLE rofl_test_base
16 ((rofl_test_base_id :type SERIAL
:primary-key t
)
17 (test_string :type string
)
18 (test_integer :type integer
)))))))
20 (deftest test-simple-insert
()
22 (let ((plist '(test-string "Test Entry" test-integer
1)))
25 (postmodern:sql-compile
`(:insert-into rofl-test-base
:set
,@plist
)))))))
27 (deftest test-rofl-select
()
31 (let* ((result (first (select '* :from
'rofl-test-base
))))
32 (is (equalp '(:ROFL-TEST-BASE-ID
1 :TEST-STRING
"Test Entry" :TEST-INTEGER
1) result
))))))
34 (deftest test-rofl-select-only-1
()
38 (let* ((result (select-only 1 '* :from
'rofl-test-base
)))
39 (is (equalp '(:ROFL-TEST-BASE-ID
1 :TEST-STRING
"Test Entry" :TEST-INTEGER
1) result
))))))
41 (deftest test-rofl-insert
()
44 (finishes (insert-into 'rofl-test-base
:test-integer
2 :test-string
"a"))
45 (finishes (insert-into 'rofl-test-base
:test-integer
3 :test-string
"b"))
46 (finishes (insert-into 'rofl-test-base
:test-integer
4 :test-string
"c"))
48 (let ((r (select '* :from
'rofl-test-base
)))
49 (is (equal 3 (length r
))))))
51 (deftest test-rofl-class-creation
()
52 (finishes (eval '(progn
53 (setf (find-class 'rofl-test-base
) nil
)
54 (defclass rofl-test-base
()
55 ((rofl-test-base-id :primary-key t
)
56 test-integer test-string
)
57 (:metaclass standard-db-access-class
))))))
60 (deftest test-rofl-make-object-from-plist
()
61 (test-rofl-class-creation)
62 (let* ((plist '(:ROFL-TEST-BASE-ID
1 :TEST-STRING
"a" :TEST-INTEGER
2))
63 (object (make-object-from-plist 'rofl-test-base plist
)))
64 (is (equal (slot-value object
'rofl-test-base-id
) 1))))
67 (deftest test-rofl-select-objects
()
69 (test-rofl-class-creation)
73 (let ((objects (select-objects 'rofl-test-base
74 :where
'(:= rofl-test-base-id
1))))
75 (is (equal (slot-value (first objects
) 'rofl-test-base-id
) 1))))))
77 (deftest test-rofl-create-references-tables
()
80 (ignore-errors (postmodern:query
(:DROP-TABLE
'rofl_test_child
)))
81 (ignore-errors (postmodern:query
(:DROP-TABLE
'rofl_test_parent
)))
83 (postmodern:query
(:CREATE-TABLE rofl_test_parent
94 (postmodern:query
(:CREATE-TABLE rofl_test_child
100 :references
(rofl_test_parent))
106 (deftest test-rofl-def-references-classes
()
110 (defclass rofl-test-parent
()
111 ((rofl-test-parent-id
115 (:metaclass standard-db-access-class
))
117 ;;; three ways to get to the parent.
118 ;;; The should all point to the same object.
120 (defclass rofl-test-child
()
124 :references rofl-test-parent
)
125 (parent :column rofl-test-parent-id
126 :references rofl-test-parent
)
127 (same-parent :column rofl-test-parent-id
128 :references
(rofl-test-parent .
129 rofl-test-parent-id
))
133 (:metaclass standard-db-access-class
))))))
135 (deftest test-rofl-foreign-references
()
136 (test-rofl-create-references-tables)
137 (test-rofl-def-references-classes)
140 (insert-into 'rofl-test-parent
:test-string
"Parent" :test-integer
1)
141 (insert-into 'rofl-test-child
:test-string
"Child 1" :test-integer
1
143 (slot-value (first (select-objects 'rofl-test-parent
)) 'rofl-test-parent-id
)))
144 (let* ((child (select-only-n-objects 1 'rofl-test-child
))
145 (parent-same-slot-name/fkey
(slot-value child
'rofl-test-parent-id
))
146 (parent-column-same-fkey (slot-value child
'parent
))
147 (parent-column-table-and-key (slot-value child
'same-parent
)))
149 (is (eql 1 (slot-value child
'test-integer
)))
151 (is (equal 1 (slot-value parent-same-slot-name
/fkey
'test-integer
)))
152 (is (equal 1 (slot-value parent-column-same-fkey
'test-integer
)))
153 (is (equal 1 (slot-value parent-column-table-and-key
'test-integer
))))))