b7657b86 |
1 | (in-package :lol-test) |
2 | |
3 | ;;;; CREATE USER rofl_test PASSWORD 'rofl_test'; |
4 | ;;;; CREATE DATABASE rofl_test OWNER rofl_test; |
5 | |
6 | |
7 | (defmacro db (&body body) |
8 | `(postmodern:with-connection '("rofl_test" "rofl_test" "rofl_test" "localhost") |
9 | ,@body)) |
10 | |
11 | (deftest test-create-table () |
12 | (finishes (db |
13 | (postmodern:query (:DROP-TABLE 'rofl_test_base)) |
14 | |
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))))))) |
19 | |
20 | (deftest test-simple-insert () |
21 | (test-create-table) |
22 | (let ((plist '(test-string "Test Entry" test-integer 1))) |
23 | (finishes (db |
24 | (postmodern:execute |
25 | (postmodern:sql-compile `(:insert-into rofl-test-base :set ,@plist))))))) |
26 | |
27 | (deftest test-rofl-select () |
28 | (test-simple-insert) |
29 | (db |
30 | (finishes |
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)))))) |
33 | |
34 | (deftest test-rofl-select-only-1 () |
35 | (test-simple-insert) |
36 | (db |
37 | (finishes |
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)))))) |
40 | |
41 | (deftest test-rofl-insert () |
42 | (test-create-table) |
43 | (db |
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")) |
47 | |
48 | (let ((r (select '* :from 'rofl-test-base))) |
49 | (is (equal 3 (length r)))))) |
50 | |
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)))))) |
58 | |
59 | |
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)))) |
65 | |
66 | |
67 | (deftest test-rofl-select-objects () |
68 | (test-create-table) |
69 | (test-rofl-class-creation) |
70 | (test-rofl-insert) |
71 | |
72 | (db (finishes |
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)))))) |
76 | |
77 | (deftest test-rofl-create-references-tables () |
78 | (finishes |
79 | (db |
80 | (ignore-errors (postmodern:query (:DROP-TABLE 'rofl_test_child))) |
81 | (ignore-errors (postmodern:query (:DROP-TABLE 'rofl_test_parent))) |
82 | |
83 | (postmodern:query (:CREATE-TABLE rofl_test_parent |
84 | ((rofl_test_parent_id |
85 | :type SERIAL |
e8fd1a9a |
86 | :primary-key t) |
b7657b86 |
87 | (test_string |
88 | :type string) |
89 | (test_integer |
90 | :type integer)))) |
91 | |
92 | |
93 | |
94 | (postmodern:query (:CREATE-TABLE rofl_test_child |
95 | ((rofl_test_child_id |
96 | :type SERIAL |
97 | :primary-key t) |
98 | (rofl_test_parent_id |
99 | :type integer |
100 | :references (rofl_test_parent)) |
101 | (test_string |
102 | :type string) |
103 | (test_integer |
104 | :type integer))))))) |
105 | |
106 | (deftest test-rofl-def-references-classes () |
107 | (finishes |
108 | (eval |
109 | '(progn |
110 | (defclass rofl-test-parent () |
111 | ((rofl-test-parent-id |
112 | :primary-key t) |
113 | (test-string) |
114 | (test-integer)) |
115 | (:metaclass standard-db-access-class)) |
116 | |
117 | ;;; three ways to get to the parent. |
118 | ;;; The should all point to the same object. |
119 | |
120 | (defclass rofl-test-child () |
121 | ((rofl-test-child-id |
e8fd1a9a |
122 | :primary-key t) ((rofl_test_child_id |
123 | :type SERIAL |
124 | :primary-key t) |
125 | (rofl_test_parent_id |
126 | :type integer |
127 | :references (rofl_test_parent)) |
128 | (test_string |
129 | :type string) |
130 | (test_integer |
131 | :type integer))))))) |
132 | |
133 | ) |
134 | |
135 | |
136 | (deftest test-rofl-def-references () |
137 | (finishes |
138 | (eval |
139 | '(progn |
140 | (defclass rofl-test-parent () |
141 | ((rofl-test-parent-id |
b7657b86 |
142 | :primary-key t) |
b7657b86 |
143 | (test-string) |
144 | (test-integer)) |
e8fd1a9a |
145 | (:metaclass standard-db-access-class)) |
146 | |
147 | ;;; three ways to get to the parent. |
148 | ;;; The should all point to the same object. |
b7657b86 |
149 | |
b7657b86 |
150 | (test-rofl-def-references-classes) |
151 | (db |
152 | (finishes |
153 | (insert-into 'rofl-test-parent :test-string "Parent" :test-integer 1) |
154 | (insert-into 'rofl-test-child :test-string "Child 1" :test-integer 1 |
155 | :rofl-test-parent-id |
156 | (slot-value (first (select-objects 'rofl-test-parent)) 'rofl-test-parent-id))) |
157 | (let* ((child (select-only-n-objects 1 'rofl-test-child)) |
158 | (parent-same-slot-name/fkey (slot-value child 'rofl-test-parent-id)) |
159 | (parent-column-same-fkey (slot-value child 'parent)) |
160 | (parent-column-table-and-key (slot-value child 'same-parent))) |
161 | |
162 | (is (eql 1 (slot-value child 'test-integer))) |
163 | |
164 | (is (equal 1 (slot-value parent-same-slot-name/fkey 'test-integer))) |
165 | (is (equal 1 (slot-value parent-column-same-fkey 'test-integer))) |
e8fd1a9a |
166 | (is (equal 1 (slot-value parent-column-table-and-key 'test-integer))))))))) |
b7657b86 |
167 | |
168 | |
169 | |
170 | |
171 | |
172 | |
173 | |
174 | |
175 | |
176 | |
177 | |
178 | |
179 | |
180 | |
181 | |
182 | |
183 | |
184 | |
185 | |
186 | |
187 | |
188 | |
189 | |
190 | |
191 | |