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

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

postgresql: Fix problem with reading of composite values with trailing NULLs

File size: 23.9 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-begin "postgresql")
7
8(test-group "connection management"
9  (test-assert "connect returns a connection"
10               (let* ((conn (connect '((dbname . test))))
11                      (isconn (connection? conn)))
12                 (disconnect conn)
13                 isconn))
14  (test-error "cannot connect with invalid credentials"
15              (connect '((dbname . does-not-exist)
16                         (username . nobody))))
17  (test-assert "reset-connection returns a connection"
18               (let* ((conn (connect '((dbname . test))))
19                      (isconn (connection? conn)))
20                 (reset-connection conn)
21                 (disconnect conn)
22                 isconn))
23  (test-error "disconnect invalidates the connection"
24              (let ((conn (connect '((dbname . test)))))
25                (disconnect conn)
26                (reset-connection conn)))
27  ;; It would be nice if we could test some more error cases here but
28  ;; that's hard to do
29  )
30
31;; From now on, just keep using the same connection
32(define conn (connect '((dbname . test))))
33
34(test-group "low-level interface"
35  (test-assert "query returns result"
36               (result? (query conn "SELECT 1")))
37  (test "Correct row count"
38        2
39        (row-count (query conn "SELECT 1 UNION SELECT 2")))
40  (test "Correct column count"
41        4
42        (column-count (query conn "SELECT 1, 2, 3, 4")))
43  (test "Correct column name"
44        'one
45        (column-name
46         (query conn "SELECT 1 AS one, 2 AS two") 0))
47  (test "Correct column names"
48        '(one two)
49        (column-names
50         (query conn "SELECT 1 AS one, 2 AS two")))
51  (test-error "Condition for nonexistant column index"
52              (column-name
53               (query conn "SELECT 1 AS one, 2 AS two") 3))
54  (test "Not false for nameless column"
55        #f ;; Could check for ?column?, but that's a bit too specific
56        (not (column-name
57              (query conn "SELECT 1, 2") 0)))
58  ;; Maybe add a few tests here for case folding/noncase folding variants?
59  ;; Perhaps column-index-ci vs column-index?  That would be
60  ;; misleading though, since column-index-ci isn't really ci,
61  ;; it will not match columns that are explicitly uppercased in the query.
62  (test "Correct column index"
63        0
64        (column-index
65         (query conn "SELECT 1 AS one, 2 AS two") 'one))
66  (test "False column index for nonexistant column name"
67        #f
68        (column-index
69         (query conn "SELECT 1 AS one, 2 AS two") 'foo))
70  (test "False oid for virtual table"
71        #f
72        (table-oid
73         (query conn "SELECT 1 AS one, 2 AS two") 0))
74  (test-assert "Number for nonvirtual table"
75               (number?
76                (table-oid
77                 (query conn "SELECT typlen FROM pg_type") 0)))
78 
79  (test-error "Condition for column index out of bounds"
80              (table-oid
81               (query conn "SELECT typname FROM pg_type") 1))
82  (test "Table column number for real table"
83        0
84        (table-column-index
85         (query conn "SELECT typname FROM pg_type") 0))
86  (test "Column format is text for normal data"
87        'text
88        (column-format
89         (query conn "SELECT 'hello'") 0))
90 
91  (test "Column format is binary for forced binary data"
92        'binary
93        (column-format
94         (query* conn "SELECT 1" '() format: 'binary) 0))
95 
96  (test "Column type OID ok"
97        23 ;; from catalog/pg_type.h
98        (column-type
99         (query conn "SELECT 1::int4") 0))
100  (test "Column modifier false"
101        #f
102        (column-type-modifier
103         (query conn "SELECT 1") 0))
104  (test "Column modifier for bit ok"
105        2
106        (column-type-modifier
107         (query conn "SELECT '10'::bit(2)") 0))
108  (test "Result value string for strings"
109        "test"
110        (value-at (query conn "SELECT 'test'")))
111  (test "Result value string for 'name' type (with no custom parser)"
112        "test"
113        (value-at (query conn "SELECT 'test'::name")))
114  (test "Result row values"
115        '("one" "two")
116        (row-values
117         (query conn "SELECT 'one', 'two' UNION SELECT 'three', 'four'") 0))
118  (test "Result row values for second row"
119        '("three" "four")
120        (row-values
121         (query conn "SELECT 'one', 'two' UNION SELECT 'three', 'four'") 1))
122  (test "Result row alist"
123        '((a . "one") (b . "two"))
124        (row-alist
125         (query conn "SELECT 'one' AS a, 'two' AS b UNION SELECT 'three', 'four'") 0))
126  (test "Result row alist for second row"
127        '((a . "three") (b . "four"))
128        (row-alist
129         (query conn "SELECT 'one' AS a, 'two' AS b UNION SELECT 'three', 'four'") 1))
130  (test "Result column values"
131        '("one" "three")
132        (column-values
133         (query conn "SELECT 'one', 'two' UNION SELECT 'three', 'four'") 0))
134  (test "Result column values for second column"
135        '("two" "four")
136        (column-values
137         (query conn "SELECT 'one', 'two' UNION SELECT 'three', 'four'") 1))
138  (test "Result value number for numbers"
139        1
140        (value-at (query conn "SELECT 1")))
141  (test "Result value string for raw numbers"
142        "1"
143        (value-at (query conn "SELECT 1") 0 0 raw: #t))
144  ;; We are using two levels of escaping here because the ::bytea cast
145  ;; performs another string interpretation. Yes, this is kinda confusing...
146  (test "Result value for null-terminated byte array"
147        (blob->u8vector (string->blob "h\x00ello"))
148        (value-at (query conn "SELECT E'h\\\\000ello'::bytea")))
149  (test "Result value for raw null-terminated byte array"
150        "h\\000ello"
151        (value-at (query conn "SELECT E'h\\\\000ello'::bytea") 0 0 raw: #t))
152
153  (test "Result value blob for binary string"
154        (string->blob "hello")
155        (value-at (query* conn "SELECT 'hello'" '() format: 'binary)))
156 
157  (test "Result value blob for binary integer"
158        (u8vector->blob (u8vector 0 0 0 1))
159        (value-at (query* conn "SELECT 1::int4" '() format: 'binary)))
160
161  (test "Result value for binary string with NUL bytes"
162        (string->blob "h\x00ello")
163        (value-at (query* conn "SELECT E'h\\\\000ello'::bytea" '() format: 'binary)))
164
165  (test "Result value for array of integers"
166        `#(1 ,(sql-null) 3) ;; Not sure if comparing sql-null is kosher
167        (value-at (query conn "SELECT array[1, null, 3]")))
168
169  (test "Result value for nested array of ints"
170        `#(#(1 ,(sql-null) 3)
171           #(4 5 ,(sql-null))) ;; Not sure if comparing sql-null is kosher
172        (value-at
173         (query conn "SELECT array[array[1, null, 3], array[4, 5, NULL]]")))
174 
175  (test "Result value for array of strings"
176        `#("a" ,(sql-null) "c") ;; Not sure if comparing sql-null is kosher
177        (value-at (query conn "SELECT array['a', null, 'c']")))
178
179  (test "Result value for nested array of strings"
180        `#(#("a" ,(sql-null) "c")
181           #("NULL" "e" ,(sql-null))) ;; Not sure if comparing sql-null is kosher
182        (value-at (query conn "SELECT array[array['a', null, 'c'], array['NULL', 'e', NULL]]")))
183 
184  (test "Result value at row 0, column 1"
185        2
186        (value-at (query conn "SELECT 1, 2 UNION SELECT 3, 4") 1 0))
187  (test "Result value at row 1, column 0"
188        3
189        (value-at (query conn "SELECT 1, 2 UNION SELECT 3, 4") 0 1))
190  (test-assert "Result value sql-null for NULL"
191               (sql-null? (value-at (query conn "SELECT NULL"))))
192  (test-error "Result value error for out of bounds row"
193              (value-at (query conn "SELECT NULL") 0 1))
194  (test-error "Result value error for out of bounds column"
195              (value-at (query conn "SELECT NULL") 1 0))
196  (test "Number of affected rows false with SELECT"
197        #f
198        (affected-rows
199         (query conn "SELECT 1")))
200
201  (query conn "BEGIN")
202  (query conn "CREATE TEMP TABLE foo ( bar integer ) ON COMMIT DROP")
203  (test "Number of affected rows 1 with INSERT"
204        1
205        (affected-rows
206         (query conn "INSERT INTO foo (bar) VALUES (1);")))
207  (query conn "COMMIT")
208
209  (query conn "BEGIN")
210  (query conn "CREATE TEMP TABLE foo ( bar integer ) ON COMMIT DROP")
211  (query conn "INSERT INTO foo (bar) VALUES (100);")
212  (query conn "INSERT INTO foo (bar) VALUES (101);")
213  (test "Number of affected rows 2 with UPDATE of two rows"
214        2
215        (affected-rows
216         (query conn "UPDATE foo SET bar=102;")))
217  (query conn "COMMIT")
218 
219  (test "Inserted OID false on SELECT"
220        #f
221        (inserted-oid
222         (query conn "SELECT 1")))
223
224  (query conn "BEGIN")
225  (query conn "CREATE TEMP TABLE foo ( bar integer ) ON COMMIT DROP")
226  (test "Inserted OID false on OID-less table"
227        #f
228        (inserted-oid
229         (query conn  "INSERT INTO foo (bar) VALUES (1);")))
230  (query conn "COMMIT")
231 
232  (query conn "BEGIN")
233  (query conn "CREATE TEMP TABLE foo ( bar integer ) WITH (OIDS=true) ON COMMIT DROP")
234  (test-assert "Inserted OID number on table with OID"
235               (number?
236                (inserted-oid
237                 (query conn "INSERT INTO foo (bar) VALUES (1)"))))
238  (query conn "COMMIT")
239
240  (test "regular parameters"
241        "hi"
242        (value-at (query conn "SELECT $1::text" "hi") 0 0))
243  (test-assert "NULL parameters"
244               (sql-null? (value-at
245                           (query conn "SELECT $1::text" (sql-null)) 0 0)))
246  (test "blob parameters"
247        "hi"
248        (value-at (query conn "SELECT $1::text" (string->blob "hi")) 0 0))
249  (test "boolean parameters"
250        '(#t #f)
251        (row-values (query conn "SELECT $1::bool, $2::bool" #t #f)))
252  (test "integer array parameters"
253        `(#(1 2) #(,(sql-null) 4))
254        (row-values (query conn "SELECT $1::int[], $2::int[]"
255                           `#(1 2) `#(,(sql-null) 4))))
256  (test "nested integer array parameters"
257        `(#(#(1 2) #(,(sql-null) 4)))
258        (row-values (query conn "SELECT $1::int[][]"
259                           `#(#(1 2) #(,(sql-null) 4)))))
260  (test "string array parameters (including 'null')"
261        `(#("a" "b") #(,(sql-null) "null"))
262        (row-values (query conn "SELECT $1::text[], $2::text[]"
263                           `#("a" "b") `#(,(sql-null) "null"))))
264  (test "string array parameters with meta-characters"
265        `(#("a\\b" "c\"d") #("{" "}"))
266        (row-values (query conn "SELECT $1::text[], $2::text[]"
267                           '#("a\\b" "c\"d") '#("{" "}"))))
268  (test "nested string array parameters"
269        `(#(#("a" "b") #(,(sql-null) "null")))
270        (row-values (query conn "SELECT $1::text[][]"
271                           `#(#("a" "b") #(,(sql-null) "null")))))
272  (test "array bounds are ignored"
273        `#(#(#(1 2 3) #(4 5 6)))
274        (value-at
275         (query conn
276                "SELECT '[1:1][-2:-1][3:5]={{{1,2,3},{4,5,6}}}'::int[] AS f1")))
277
278  ;; Basic domains seem to return just their base type
279  (query conn "BEGIN")
280  (query conn "CREATE DOMAIN mydom AS integer CHECK (VALUE > 2)")
281  (test "basic domains"
282        3
283        (value-at (query conn "SELECT $1::mydom" 3)))
284  (query conn "ROLLBACK")
285 
286  (query conn "BEGIN")
287  (query conn "CREATE TYPE foo AS ( a integer, b text )")
288  (test "basic composite type"
289        `(1 "one")
290        (value-at (query conn "SELECT $1::foo" `(1 "one"))))
291  (test "composite type with meta-characters"
292        `(123 "\\backslash\"quote")
293        (value-at (query conn "SELECT $1::foo" `(123 "\\backslash\"quote"))))
294  (query conn "CREATE TYPE bar AS ( x foo, y integer )")
295  (test "Nested composite type"
296        `((2 "two") 3)
297        (value-at (query conn "SELECT $1::bar" `((2 "two") 3))))
298  (query conn "CREATE DOMAIN mydom AS integer CHECK (VALUE > 1)")
299  (query conn "CREATE TYPE qux AS ( i integer, d mydom )")
300  (test "Composite type containing domain value"
301        `(1 2)
302        (value-at (query conn "SELECT $1::qux" `(1 2))))
303  (query conn "ROLLBACK")
304
305  (test "anonymous composite type ('record')"
306        '("one" "two")
307        (value-at (query conn "SELECT ROW('one', 'two')")))
308
309  (test "anonymous composite type ('record') with NULL"
310        `("one" ,(sql-null))
311        (value-at (query conn "SELECT ROW('one', NULL)"))))
312
313(test-group "value escaping"
314  (test "String is escaped correctly"
315        "What''s up?"
316        (escape-string conn "What's up?"))
317  (test "Bytea is escaped correctly"
318        "Wh\\\\000at''s\\\\012up?"
319        (escape-bytea conn "Wh\x00at's\nup?"))
320  (test "Bytea is unescaped correctly"
321        "What's\nup?"
322        ;; The extra quote is dropped here because it wouldn't be returned
323        ;; by pgsql either.
324        (unescape-bytea "What's\\012up?")))
325
326(test-group "COPY support"
327  (query conn "CREATE TEMP TABLE copy_table ( nr integer, s text )")
328  (test-group "low-level interface"
329    (test-error "Cannot put copy data while no COPY in progress"
330                (put-copy-data conn "whatever"))
331    (query conn "COPY copy_table (s, nr) FROM STDIN")
332    (test-error "Cannot initiate new query while waiting for COPY input"
333                (query conn "SELECT 1"))
334    (put-copy-data conn "one\t1\n")
335    (test-error "Cannot initiate new query while COPY data in progress"
336                (query conn "SELECT 1"))
337    (put-copy-data conn "two\t2")
338    (put-copy-end conn)
339    (let ((res (query conn "SELECT * FROM copy_table")))
340      (test "Simple copy from STDIN works"
341            '((1 "one")
342              (2 "two"))         
343            (list (row-values res 0) (row-values res 1))))
344    (test-error "Cannot get copy data while no COPY in progress"
345                (get-copy-data conn))
346    (query conn "COPY copy_table (s, nr) TO STDOUT")
347    (test-error "Cannot initiate new query while waiting for COPY output"
348                (query conn "SELECT 1"))
349    (test "Simple copy to STDOUT works, first record"
350          "one\t1\n"
351          (get-copy-data conn))
352    (test-error "Cannot initiate new query while reading COPY data"
353                (query conn "SELECT 1"))
354    (test "Simple copy to STDOUT works, second record"
355          "two\t2\n"
356          (get-copy-data conn))
357    (test-assert "EOF is marked by a result object"
358                 (result? (get-copy-data conn))))
359  (test-group "high-level interface"
360    (test "Mapping"
361          '(("one" "1")
362            ("two" "2"))
363          (copy-query-map string-split conn "COPY copy_table (s, nr) TO STDOUT"))
364    (test "Error while mapping gets connection out of COPY state"
365          "okay"
366          (handle-exceptions exn
367            (value-at (query conn "SELECT 'okay'"))
368            (copy-query-map (lambda _ (error "blah"))
369                            conn "COPY copy_table (s, nr) TO STDOUT")))
370    (test "Fold"
371          '(("one" "1")
372            ("two" "2"))
373          (reverse
374           (copy-query-fold
375            (lambda (data result)
376              (cons (string-split data) result))
377            '() conn "COPY copy_table (s, nr) TO STDOUT")))
378    (test "Error while folding gets connection out of COPY state"
379          "okay"
380          (handle-exceptions exn
381            (value-at (query conn "SELECT 'okay'"))
382            (copy-query-fold (lambda _ (error "blah"))
383                             '() conn "COPY copy_table (s, nr) TO STDOUT")))
384    (test "Fold-right"
385          '(("one" "1")
386            ("two" "2"))
387          (copy-query-fold-right
388           (lambda (data result)
389             (cons (string-split data) result))
390           '() conn "COPY copy_table (s, nr) TO STDOUT"))
391    (test "Error while folding right gets connection out of COPY state"
392          "okay"
393          (handle-exceptions exn
394            (value-at (query conn "SELECT 'okay'"))
395            (copy-query-fold-right (lambda _ (error "blah"))
396                                   '() conn "COPY copy_table (s, nr) TO STDOUT")))
397    (test "For-each"
398          '(("one" "1")
399            ("two" "2"))
400          (let ((res '()))
401            (copy-query-for-each (lambda (x)
402                                   (set! res (cons (string-split x) res)))
403                                 conn "COPY copy_table (s, nr) TO STDOUT")
404            (reverse res)))
405    (test "Error during for-each gets connection out of COPY state"
406          "okay"
407          (handle-exceptions exn
408            (value-at (query conn "SELECT 'okay'"))
409            (copy-query-for-each (lambda (x) (error "blah"))
410                                 conn "COPY copy_table (s, nr) TO STDOUT")))
411    (query conn "TRUNCATE copy_table")
412    (with-output-to-copy-query (lambda ()
413                                 (print "first\t1")
414                                 (print "second\t2"))
415                               conn "COPY copy_table (s, nr) FROM STDIN")
416    (test "Port interface inserted data correctly"
417          '(("first" 1)
418            ("second" 2))
419          (let ((res (query conn "SELECT s, nr FROM copy_table")))
420            (list (row-values res 0) (row-values res 1))))
421    (query conn "TRUNCATE copy_table")
422    (handle-exceptions _
423      (void)
424      (with-output-to-copy-query (lambda ()
425                                   (print "first\t1")
426                                   (print "second\t2")
427                                   (error "blah"))
428                                 conn "COPY copy_table (s, nr) FROM STDIN"))
429    (test "Error inside with-output-to-copy caused abort of insert"
430          0 (value-at (query conn "SELECT COUNT(*) FROM copy_table")))))
431
432(test-group "type parsers"
433  (test "Integer parsed correctly"
434        1234
435        (numeric-parser "1234"))
436  (test "Float parsed correctly"
437        123.456
438        (numeric-parser "123.456"))
439  (test-error "Non-integer is an error"
440              (numeric-parser "not an integer"))
441  (test "Boolean true parsed correctly"
442        #t
443        (bool-parser "t"))
444  (test "Boolean false parsed correctly"
445        #f
446        (bool-parser "f"))
447  (test "Byte array parsed correctly"
448        (blob->u8vector/shared (string->blob "abc\x01\x02\xffdef"))
449        (bytea-parser "abc\\001\\002\\377def"))
450  (test "Char parser"
451        #\x
452        (char-parser "x")))
453
454(test-group "type unparsers"
455  (test "Boolean true unparsed correctly"
456        "TRUE"
457        (bool-unparser conn #t))
458  (test "Boolean false unparsed correctly"
459        "FALSE"
460        (bool-unparser conn #f)))
461
462(test-group "high-level interface"
463  (test "row-fold"
464        '(("one" 2)
465          ("three" 4))
466        (reverse
467         (row-fold
468          cons '()
469          (query conn
470                 "SELECT $1::text, $2::integer UNION SELECT 'three', 4"
471                 "one" 2))))
472  (test "column-fold"
473        '(("one" "three")
474          (2 4))
475        (reverse
476         (column-fold
477          cons '()
478          (query conn
479                 "SELECT $1::text, $2::integer UNION SELECT 'three', 4"
480                 "one" 2))))
481  (test "row-fold-right"
482        '(("one" 2)
483          ("three" 4))
484        (row-fold-right
485         cons '()
486         (query conn
487                "SELECT $1::text, $2::integer UNION SELECT 'three', 4"
488                "one" 2)))
489  (test "column-fold-right"
490        '(("one" "three")
491          (2 4))
492        (column-fold-right
493         cons '()
494         (query conn
495                "SELECT $1::text, $2::integer UNION SELECT 'three', 4"
496                "one" 2)))
497  (test "row-for-each"
498        '(("one" 2)
499          ("three" 4))
500        (let ((res '()))
501          (row-for-each
502           (lambda (row) (set! res (cons row res)))
503           (query
504            conn
505            "SELECT $1::text, $2::integer UNION SELECT 'three', 4" "one" 2))
506          (reverse res)))
507  (test "column-for-each"
508        '(("one" "three")
509          (2 4))
510        (let ((res '()))
511          (column-for-each
512           (lambda (col) (set! res (cons col res)))
513           (query
514            conn
515            "SELECT $1::text, $2::integer UNION SELECT 'three', 4" "one" 2))
516          (reverse res)))
517  (test "row-map"
518        '(("one" 2)
519          ("three" 4))
520        (row-map
521         identity
522         (query conn
523                "SELECT $1::text, $2::integer UNION SELECT 'three', 4" "one" 2)))
524  (test "column-map"
525        '(("one" "three")
526          (2 4))
527        (column-map
528         identity
529         (query conn
530                "SELECT $1::text, $2::integer UNION SELECT 'three', 4" "one" 2))))
531
532(test-group "transactions"
533  (query conn "CREATE TEMP TABLE foo ( bar integer )")
534
535  (test-group "simple transactions"
536    (test "Transaction inactive"
537          #f
538          (in-transaction? conn))
539    (test "Transaction active"
540          #t
541          (with-transaction conn
542                            (lambda () (in-transaction? conn))))
543    (test "Successful transaction"
544          '(1)
545          (and
546           (with-transaction
547            conn (lambda ()
548                   (query conn "INSERT INTO foo (bar) VALUES (1)")))
549           (column-values (query conn "SELECT * FROM foo"))))
550 
551    (query conn "TRUNCATE foo")
552 
553    (test "Unsuccessful transaction"
554          #f
555          (with-transaction
556           conn (lambda ()
557                  (query conn "INSERT INTO foo (bar) VALUES (1)")
558                  #f)))
559
560    (test "Empty table after unsuccessful transaction"
561          '()
562          (column-values (query conn "SELECT * FROM foo")))
563
564    (handle-exceptions exn
565      (void)
566      (with-transaction
567       conn (lambda ()
568              (query conn "INSERT INTO foo (bar) VALUES (1)")
569              (error "oops!"))))
570 
571    (test "Exception during transaction causes reset"
572          '()
573          (column-values (query conn "SELECT * FROM foo"))))
574
575  (test-group "nested transactions"
576    (test "Successful transaction"
577          '(1 2)
578          (and
579           (with-transaction
580            conn (lambda ()
581                   (query conn "INSERT INTO foo (bar) VALUES (1)")
582                   (with-transaction
583                    conn (lambda ()
584                           (query conn "INSERT INTO foo (bar) VALUES (2)")))))
585           (column-values (query conn "SELECT * FROM foo"))))
586   
587    (query conn "TRUNCATE foo")
588
589    (test "Unsuccessful main transaction"
590          '()
591          (and
592           (not
593            (with-transaction
594             conn (lambda ()
595                    (query conn "INSERT INTO foo (bar) VALUES (1)")
596                    (with-transaction
597                     conn (lambda ()
598                            (query conn "INSERT INTO foo (bar) VALUES (2)")))
599                    #f)))
600           (column-values (query conn "SELECT * FROM foo"))))
601   
602    (test "Unsuccessful subtransaction"
603          '(1)
604          (and
605           (with-transaction
606            conn (lambda ()
607                   (query conn "INSERT INTO foo (bar) VALUES (1)")
608                   (with-transaction
609                    conn (lambda ()
610                           (query conn "INSERT INTO foo (bar) VALUES (2)")
611                           #f))
612                   #t))
613           (column-values (query conn "SELECT * FROM foo"))))
614
615    (query conn "TRUNCATE foo")
616
617    ;; Test that errors do not kill the transaction.  Apparently
618    ;; aborting transactions on errors is a psql(1) "feature", not a
619    ;; libpq one.
620    (test "Unsuccessful subtransaction with bad query"
621          '(1 2)
622          (and
623           (with-transaction
624            conn (lambda ()
625                   (query conn "INSERT INTO foo (bar) VALUES (1)")
626                   (handle-exceptions exn
627                     #t
628                     (with-transaction
629                      conn (lambda ()
630                             (query conn "INVALID QUERY"))))
631                   (query conn "INSERT INTO foo (bar) VALUES (2)")))
632           (column-values (query conn "SELECT * FROM foo"))))
633
634    (query conn "TRUNCATE foo")
635
636    (test "Multiple subtransactions"
637          '(1 3)
638          (and
639           (with-transaction
640            conn (lambda ()
641                   (query conn "INSERT INTO foo (bar) VALUES (1)")
642                   (with-transaction
643                    conn (lambda ()
644                           (query conn "INSERT INTO foo (bar) VALUES (2)")
645                           #f))
646                   (with-transaction
647                    conn (lambda ()
648                           (query conn "INSERT INTO foo (bar) VALUES (3)")))))
649           (column-values (query conn "SELECT * FROM foo")))))
650  )
651
652(test-end)
653
654(unless (zero? (test-failure-count)) (exit 1))
Note: See TracBrowser for help on using the repository browser.