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

Last change on this file since 14725 was 14725, checked in by sjamaan, 10 years ago

Improve binary mode result fetching by sticking it into a blob.
The user should figure out what the fuck to do with it :)
(the internal representation is used on the wire and this may change, especially for complex datatypes)

File size: 8.8 KB
Line 
1(use test postgresql sql-null)
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 "simple query returns one result"
34        1
35        (length (exec-query conn "SELECT 1")))
36  (test "multi-query returns more results"
37        3
38        (length (exec-query conn "SELECT 1; SELECT 'hello'; SELECT TRUE")))
39  (test "Correct row count"
40        2
41        (result-rows (car (exec-query conn "SELECT 1 UNION SELECT 2"))))
42  (test "Correct column count"
43        4
44        (result-columns (car (exec-query conn "SELECT 1, 2, 3, 4"))))
45  (test "Correct column name"
46        "one"
47        (result-column-name
48         (car (exec-query conn "SELECT 1 AS one, 2 AS two")) 0))
49  (test-error "Condition for nonexistant column index"
50              (result-column-name
51               (car (exec-query conn "SELECT 1 AS one, 2 AS two")) 3))
52  (test "Not false for nameless column"
53        #f ;; Could check for "?column?", but that's a bit too specific
54        (not (result-column-name
55              (car (exec-query conn "SELECT 1, 2")) 0)))
56  ;; Maybe add a few tests here for case folding/noncase folding variants?
57  ;; Perhaps result-column-index-ci vs result-column-index?  That would be
58  ;; misleading though, since result-column-index-ci isn't really ci,
59  ;; it will not match columns that are explicitly uppercased in the query.
60  (test "Correct column index"
61        0
62        (result-column-index
63         (car (exec-query conn "SELECT 1 AS one, 2 AS two")) "one"))
64  (test "False column index for nonexistant column name"
65        #f
66        (result-column-index
67         (car (exec-query conn "SELECT 1 AS one, 2 AS two")) "foo"))
68  (test "False oid for virtual table"
69        #f
70        (result-table-oid
71         (car (exec-query conn "SELECT 1 AS one, 2 AS two")) 0))
72  (test-assert "Number for nonvirtual table"
73               (number?
74                (result-table-oid
75                 (car (exec-query conn "SELECT typlen FROM pg_type")) 0)))
76  (test-error "Condition for column index out of bounds"
77              (result-table-oid
78               (car (exec-query conn "SELECT typname FROM pg_type")) 1))
79  (test "Table column number for real table"
80        0
81        (result-table-column-index
82         (car (exec-query conn "SELECT typname FROM pg_type")) 0))
83  (test "Column format is text for normal data"
84        'text
85        (result-column-format
86         (car (exec-query conn "SELECT 'hello'")) 0))
87  ;; The only easy way to get a binary column is by creating a binary cursor
88  (test "Column format is binary for forced binary data"
89        'binary
90        (result-column-format
91         (cadr (exec-query conn
92                           (conc "DECLARE b1 BINARY CURSOR FOR SELECT 'hello';"
93                                 "FETCH FORWARD 1 FROM b1;"
94                                 "CLOSE b1"))) 0))
95  (test "Column type OID ok"
96        23 ;; from catalog/pg_type.h
97        (result-column-type
98         (car (exec-query conn "SELECT 1::int4")) 0))
99  (test "Column modifier false"
100        #f
101        (result-column-type-modifier
102         (car (exec-query conn "SELECT 1")) 0))
103  (test "Column modifier for bit ok"
104        2
105        (result-column-type-modifier
106         (car (exec-query conn "SELECT '10'::bit(2)")) 0))
107  (test "Result value string for strings"
108        "test"
109        (result-value
110         (car (exec-query conn "SELECT 'test'")) 0 0))
111  (test "Result value string for numbers"
112        "1"
113        (result-value
114         (car (exec-query conn "SELECT 1")) 0 0))
115  ;; We are using two levels of escaping here because the ::bytea cast
116  ;; performs another string interpretation. Yes, this is kinda confusing...
117  (test "Result value for null-terminated normal string"
118        "h\\000ello" ;; This would then be decoded using unescape-bytea
119        (result-value
120         (car (exec-query conn "SELECT E'h\\\\000ello'::bytea")) 0 0))
121  (test "Result value blob for binary string"
122        (string->blob "hello")
123        (result-value
124         (cadr (exec-query conn
125                           (conc "DECLARE b1 BINARY CURSOR FOR SELECT 'hello';"
126                                 "FETCH FORWARD 1 FROM b1;"
127                                 "CLOSE b1"))) 0 0))
128  (test "Result value blob for binary integer"
129        (u8vector->blob (u8vector 0 0 0 1))
130        (result-value
131         (cadr (exec-query conn
132                           (conc "DECLARE b1 BINARY CURSOR FOR SELECT 1::int4;"
133                                 "FETCH FORWARD 1 FROM b1;"
134                                 "CLOSE b1"))) 0 0))
135  (test "Result value for null-terminated binary string"
136        (string->blob "h\x00ello")
137        (result-value
138         (cadr (exec-query conn
139                           (conc "DECLARE b1 BINARY CURSOR FOR SELECT E'h\\\\000ello'::bytea;"
140                                 "FETCH FORWARD 1 FROM b1;"
141                                 "CLOSE b1"))) 0 0))
142  (test-assert "Result value sql-null for NULL"
143               (sql-null? (result-value
144                           (car (exec-query conn "SELECT NULL")) 0 0)))
145  (test-error "Result value error for out of bounds column"
146              (result-value
147               (car (exec-query conn "SELECT NULL")) 0 1))
148  (test-error "Result value error for out of bounds row"
149              (result-value
150               (car (exec-query conn "SELECT NULL")) 1 0))
151  (test "Number of affected rows false with SELECT"
152        #f
153        (result-affected-rows
154         (car (exec-query conn "SELECT 1"))))
155  (test "Number of affected rows 1 with INSERT"
156        1
157        (result-affected-rows
158         (third (exec-query conn (conc "BEGIN;"
159                                       "CREATE TEMP TABLE foo "
160                                       "( bar integer ) ON COMMIT DROP;"
161                                       "INSERT INTO foo (bar) VALUES (1);"
162                                       "COMMIT;")))))
163  (test "Number of affected rows 2 with UPDATE of two rows"
164        2
165        (result-affected-rows
166         (fifth (exec-query conn (conc "BEGIN;"
167                                       "CREATE TEMP TABLE foo "
168                                       "( bar integer ) ON COMMIT DROP;"
169                                       "INSERT INTO foo (bar) VALUES (100);"
170                                       "INSERT INTO foo (bar) VALUES (101);"
171                                       "UPDATE foo SET bar=102;"
172                                       "COMMIT;")))))
173  (test "Inserted OID false on SELECT"
174        #f
175        (result-inserted-oid
176         (car (exec-query conn "SELECT 1"))))
177  (test "Inserted OID false on OID-less table"
178        #f
179        (result-inserted-oid
180         (third (exec-query conn (conc "BEGIN;"
181                                       "CREATE TEMP TABLE foo "
182                                       "( bar integer ) ON COMMIT DROP;"
183                                       "INSERT INTO foo (bar) VALUES (1);"
184                                       "COMMIT;")))))
185  (test-assert
186   "Inserted OID number on table with OID"
187   (number?
188    (result-inserted-oid
189     (third (exec-query conn (conc "BEGIN;"
190                                   "CREATE TEMP TABLE foo (bar integer) "
191                                   "WITH (OIDS=true) ON COMMIT DROP;"
192                                   "INSERT INTO foo (bar) VALUES (1);"
193                                   "COMMIT;")))))))
194
195(test-group "value escaping"
196  (test "String is escaped correctly"
197        "What''s up?"
198        (escape-string conn "What's up?"))
199  (test "Bytea is escaped correctly"
200        "What''s\\012up?"
201        (escape-bytea conn "What's\nup?"))
202  (test "Bytea is unescaped correctly"
203        "What's\nup?"
204        ;; The extra quote is dropped here because it wouldn't be returned
205        ;; by pgsql either.
206        (unescape-bytea "What's\\012up?")))
Note: See TracBrowser for help on using the repository browser.