source: project/release/4/postgresql/trunk/tests/run.scm @ 14792

Last change on this file since 14792 was 14792, checked in by sjamaan, 11 years ago

Make the interface more awesome by making row/column numbers optional

File size: 11.8 KB
Line 
1(use test postgresql sql-null srfi-4)
2
3;; These tests assume that the current UNIX user has access to a database
4;; named 'test'.  The tests will fail otherwise.
5
6(test-group "connection management"
7  (test-assert "connect returns a connection"
8               (let* ((conn (connect '((dbname . test))))
9                      (isconn (connection? conn)))
10                 (disconnect conn)
11                 isconn))
12  (test-error "cannot connect with invalid credentials"
13              (connect '((dbname . does-not-exist)
14                         (username . nobody))))
15  (test-assert "reset-connection returns a connection"
16               (let* ((conn (connect '((dbname . test))))
17                      (isconn (connection? conn)))
18                 (reset-connection conn)
19                 (disconnect conn)
20                 isconn))
21  (test-error "disconnect invalidates the connection"
22              (let ((conn (connect '((dbname . test)))))
23                (disconnect conn)
24                (reset-connection conn)))
25  ;; It would be nice if we could test some more error cases here but
26  ;; that's hard to do
27  )
28
29;; From now on, just keep using the same connection
30(define conn (connect '((dbname . test))))
31
32(test-group "low-level interface"
33  (test-assert "query returns result"
34               (result? (query conn "SELECT 1")))
35  (test "multi-query returns several results"
36        2
37        (length (multi-query conn "SELECT 10; SELECT 100")))
38  (test "Correct row count"
39        2
40        (row-count (query conn "SELECT 1 UNION SELECT 2")))
41  (test "Correct column count"
42        4
43        (column-count (query conn "SELECT 1, 2, 3, 4")))
44  (test "Correct column name"
45        'one
46        (column-name
47         (query conn "SELECT 1 AS one, 2 AS two") 0))
48  (test "Correct column names"
49        '(one two)
50        (column-names
51         (query conn "SELECT 1 AS one, 2 AS two")))
52  (test-error "Condition for nonexistant column index"
53              (column-name
54               (query conn "SELECT 1 AS one, 2 AS two") 3))
55  (test "Not false for nameless column"
56        #f ;; Could check for ?column?, but that's a bit too specific
57        (not (column-name
58              (query conn "SELECT 1, 2") 0)))
59  ;; Maybe add a few tests here for case folding/noncase folding variants?
60  ;; Perhaps column-index-ci vs column-index?  That would be
61  ;; misleading though, since column-index-ci isn't really ci,
62  ;; it will not match columns that are explicitly uppercased in the query.
63  (test "Correct column index"
64        0
65        (column-index
66         (query conn "SELECT 1 AS one, 2 AS two") 'one))
67  (test "False column index for nonexistant column name"
68        #f
69        (column-index
70         (query conn "SELECT 1 AS one, 2 AS two") 'foo))
71  (test "False oid for virtual table"
72        #f
73        (table-oid
74         (query conn "SELECT 1 AS one, 2 AS two") 0))
75  (test-assert "Number for nonvirtual table"
76               (number?
77                (table-oid
78                 (query conn "SELECT typlen FROM pg_type") 0)))
79 
80  (test-error "Condition for column index out of bounds"
81              (table-oid
82               (query conn "SELECT typname FROM pg_type") 1))
83  (test "Table column number for real table"
84        0
85        (table-column-index
86         (query conn "SELECT typname FROM pg_type") 0))
87  (test "Column format is text for normal data"
88        'text
89        (column-format
90         (query conn "SELECT 'hello'") 0))
91 
92  (test "Column format is binary for forced binary data"
93        'binary
94        (column-format
95         (query* conn "SELECT 1" '() format: 'binary) 0))
96 
97  (test "Column type OID ok"
98        23 ;; from catalog/pg_type.h
99        (column-type
100         (query conn "SELECT 1::int4") 0))
101  (test "Column modifier false"
102        #f
103        (column-type-modifier
104         (query conn "SELECT 1") 0))
105  (test "Column modifier for bit ok"
106        2
107        (column-type-modifier
108         (query conn "SELECT '10'::bit(2)") 0))
109  (test "Result value string for strings"
110        "test"
111        (value-at (query conn "SELECT 'test'")))
112  (test "Result row values"
113        '("one" "two")
114        (row-values
115         (query conn "SELECT 'one', 'two' UNION SELECT 'three', 'four'") 0))
116  (test "Result row values for second row"
117        '("three" "four")
118        (row-values
119         (query conn "SELECT 'one', 'two' UNION SELECT 'three', 'four'") 1))
120  (test "Result row alist"
121        '((a . "one") (b . "two"))
122        (row-alist
123         (query conn "SELECT 'one' AS a, 'two' AS b UNION SELECT 'three', 'four'") 0))
124  (test "Result row alist for second row"
125        '((a . "three") (b . "four"))
126        (row-alist
127         (query conn "SELECT 'one' AS a, 'two' AS b UNION SELECT 'three', 'four'") 1))
128  (test "Result column values"
129        '("one" "three")
130        (column-values
131         (query conn "SELECT 'one', 'two' UNION SELECT 'three', 'four'") 0))
132  (test "Result column values for second column"
133        '("two" "four")
134        (column-values
135         (query conn "SELECT 'one', 'two' UNION SELECT 'three', 'four'") 1))
136  (test "Result value number for numbers"
137        1
138        (value-at (query conn "SELECT 1")))
139  (test "Result value string for raw numbers"
140        "1"
141        (value-at (query conn "SELECT 1") 0 0 raw: #t))
142  ;; We are using two levels of escaping here because the ::bytea cast
143  ;; performs another string interpretation. Yes, this is kinda confusing...
144  (test "Result value for null-terminated byte array"
145        (blob->u8vector (string->blob "h\x00ello"))
146        (value-at (query conn "SELECT E'h\\\\000ello'::bytea")))
147  (test "Result value for raw null-terminated byte array"
148        "h\\000ello"
149        (value-at (query conn "SELECT E'h\\\\000ello'::bytea") 0 0 raw: #t))
150
151  (test "Result value blob for binary string"
152        (string->blob "hello")
153        (value-at (query* conn "SELECT 'hello'" '() format: 'binary)))
154 
155  (test "Result value blob for binary integer"
156        (u8vector->blob (u8vector 0 0 0 1))
157        (value-at (query* conn "SELECT 1::int4" '() format: 'binary)))
158
159  (test "Result value for binary string with NUL bytes"
160        (string->blob "h\x00ello")
161        (value-at (query* conn "SELECT E'h\\\\000ello'::bytea" '() format: 'binary)))
162
163  (test "Result value at row 0, column 1"
164        2
165        (value-at (query conn "SELECT 1, 2 UNION SELECT 3, 4") 1 0))
166  (test "Result value at row 1, column 0"
167        3
168        (value-at (query conn "SELECT 1, 2 UNION SELECT 3, 4") 0 1))
169  (test-assert "Result value sql-null for NULL"
170               (sql-null? (value-at (query conn "SELECT NULL"))))
171  (test-error "Result value error for out of bounds row"
172              (value-at (query conn "SELECT NULL") 0 1))
173  (test-error "Result value error for out of bounds column"
174              (value-at (query conn "SELECT NULL") 1 0))
175  (test "Number of affected rows false with SELECT"
176        #f
177        (affected-rows
178         (query conn "SELECT 1")))
179
180  (query conn "BEGIN")
181  (query conn "CREATE TEMP TABLE foo ( bar integer ) ON COMMIT DROP")
182  (test "Number of affected rows 1 with INSERT"
183        1
184        (affected-rows
185         (query conn "INSERT INTO foo (bar) VALUES (1);")))
186  (query conn "COMMIT")
187
188  (query conn "BEGIN")
189  (query conn "CREATE TEMP TABLE foo ( bar integer ) ON COMMIT DROP")
190  (query conn "INSERT INTO foo (bar) VALUES (100);")
191  (query conn "INSERT INTO foo (bar) VALUES (101);")
192  (test "Number of affected rows 2 with UPDATE of two rows"
193        2
194        (affected-rows
195         (query conn "UPDATE foo SET bar=102;")))
196  (query conn "COMMIT")
197 
198  (test "Inserted OID false on SELECT"
199        #f
200        (inserted-oid
201         (query conn "SELECT 1")))
202
203  (query conn "BEGIN")
204  (query conn "CREATE TEMP TABLE foo ( bar integer ) ON COMMIT DROP")
205  (test "Inserted OID false on OID-less table"
206        #f
207        (inserted-oid
208         (query conn  "INSERT INTO foo (bar) VALUES (1);")))
209  (query conn "COMMIT")
210 
211  (query conn "BEGIN")
212  (query conn "CREATE TEMP TABLE foo ( bar integer ) WITH (OIDS=true) ON COMMIT DROP")
213  (test-assert "Inserted OID number on table with OID"
214               (number?
215                (inserted-oid
216                 (query conn "INSERT INTO foo (bar) VALUES (1)"))))
217  (query conn "COMMIT")
218
219  (test "regular parameters"
220        "hi"
221        (value-at (query conn "SELECT $1::text" "hi") 0 0))
222  (test-assert "NULL parameters"
223               (sql-null? (value-at
224                           (query conn "SELECT $1::text" (sql-null)) 0 0)))
225  (test "blob parameters"
226        "hi"
227        (value-at (query conn "SELECT $1::text" (string->blob "hi")) 0 0))
228  (test "boolean parameters"
229        '(#t #f)
230        (row-values (query conn "SELECT $1::bool, $2::bool" #t #f))))
231
232(test-group "value escaping"
233  (test "String is escaped correctly"
234        "What''s up?"
235        (escape-string conn "What's up?"))
236  (test "Bytea is escaped correctly"
237        "Wh\\\\000at''s\\\\012up?"
238        (escape-bytea conn "Wh\x00at's\nup?"))
239  (test "Bytea is unescaped correctly"
240        "What's\nup?"
241        ;; The extra quote is dropped here because it wouldn't be returned
242        ;; by pgsql either.
243        (unescape-bytea "What's\\012up?")))
244
245(test-group "type parsers"
246  (test "Integer parsed correctly"
247        1234
248        (numeric-parser "1234"))
249  (test "Float parsed correctly"
250        123.456
251        (numeric-parser "123.456"))
252  (test-error "Non-integer is an error"
253              (numeric-parser "not an integer"))
254  (test "Boolean true parsed correctly"
255        #t
256        (bool-parser "t"))
257  (test "Boolean false parsed correctly"
258        #f
259        (bool-parser "f"))
260  (test "Byte array parsed correctly"
261        (blob->u8vector/shared (string->blob "abc\x01\x02\xffdef"))
262        (bytea-parser "abc\\001\\002\\377def"))
263  (test "Char parser"
264        #\x
265        (char-parser "x")))
266
267(test-group "type unparsers"
268  (test "Boolean true unparsed correctly"
269        "TRUE"
270        (bool-unparser #t))
271  (test "Boolean false unparsed correctly"
272        "FALSE"
273        (bool-unparser #f)))
274
275(test-group "high-level interface"
276  (test "row-fold"
277        '(("one" 2)
278          ("three" 4))
279        (reverse
280         (row-fold
281          cons '()
282          (query conn
283                 "SELECT $1::text, $2::integer UNION SELECT 'three', 4"
284                 "one" 2))))
285  (test "column-fold"
286        '(("one" "three")
287          (2 4))
288        (reverse
289         (column-fold
290          cons '()
291          (query conn
292                 "SELECT $1::text, $2::integer UNION SELECT 'three', 4"
293                 "one" 2))))
294  (test "row-fold-right"
295        '(("one" 2)
296          ("three" 4))
297        (row-fold-right
298         cons '()
299         (query conn
300                "SELECT $1::text, $2::integer UNION SELECT 'three', 4"
301                "one" 2)))
302  (test "column-fold-right"
303        '(("one" "three")
304          (2 4))
305        (column-fold-right
306         cons '()
307         (query conn
308                "SELECT $1::text, $2::integer UNION SELECT 'three', 4"
309                "one" 2)))
310  (test "row-for-each"
311        '(("one" 2)
312          ("three" 4))
313        (let ((res '()))
314          (row-for-each
315           (lambda (row) (set! res (cons row res)))
316           (query
317            conn
318            "SELECT $1::text, $2::integer UNION SELECT 'three', 4" "one" 2))
319          (reverse res)))
320  (test "column-for-each"
321        '(("one" "three")
322          (2 4))
323        (let ((res '()))
324          (column-for-each
325           (lambda (col) (set! res (cons col res)))
326           (query
327            conn
328            "SELECT $1::text, $2::integer UNION SELECT 'three', 4" "one" 2))
329          (reverse res)))
330  (test "row-map"
331        '(("one" 2)
332          ("three" 4))
333        (row-map
334         identity
335         (query conn
336                "SELECT $1::text, $2::integer UNION SELECT 'three', 4" "one" 2)))
337  (test "column-map"
338        '(("one" "three")
339          (2 4))
340        (column-map
341         identity
342         (query conn
343                "SELECT $1::text, $2::integer UNION SELECT 'three', 4" "one" 2))))
Note: See TracBrowser for help on using the repository browser.