added ROFL test cases + extra formatting hooks for attributes
[clinton/lisp-on-lines.git] / src / rofl-test.lisp
CommitLineData
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
86 :primary-key t)
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
122 :primary-key t)
123 (rofl-test-parent-id
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))
130
131 (test-string)
132 (test-integer))
133 (:metaclass standard-db-access-class))))))
134
135(deftest test-rofl-foreign-references ()
136 (test-rofl-create-references-tables)
137 (test-rofl-def-references-classes)
138 (db
139 (finishes
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
142 :rofl-test-parent-id
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)))
148
149 (is (eql 1 (slot-value child 'test-integer)))
150
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))))))
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178