« back to all changes in this revision
Viewing changes to tests/tdbcpostgres.test
- browse files at revision 1
- compare with another revision
- download diff
- download tarball
- view history from revision 1
- Committer: Package Import Robot
- Author(s): Massimo Manghi
- Date: 2013-08-22 12:24:05 UTC
- Revision ID: package-import@ubuntu.com-20130822122405-doqecqb9fl6gr1k4
Tags: upstream-1.0.0
Import upstream version 1.0.0
- files added:
- generic
- library
- tclconfig
- tests
- win
added
removed
tests/tdbcpostgres.test
1
# tdbcpostgres.test --
2
#
3
# Tests for the tdbc::postgres bridge
4
#
5
# Copyright (c) 2008 by Slawomir Cygan
6
# See the file "license.terms" for information on usage and redistribution
7
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
8
#
9
#
10
#------------------------------------------------------------------------------
11
12
package require tcltest 2.2
13
namespace import -force ::tcltest::*
14
loadTestedCommands
15
package require tdbc::postgres
16
17
# We need to know the parameters of the Postgre database for testing.
18
19
set connFlags {}
20
if {[info exists env(TDBCPOSTGRES_HOST)]} {
21
lappend connFlags -host $env(TDBCPOSTGRES_HOST)
22
}
23
if {[info exists env(TDBCPOSTGRES_USER)]} {
24
lappend connFlags -user $env(TDBCPOSTGRES_USER)
25
}
26
if {[info exists env(TDBCPOSTGRES_PASSWD)]} {
27
lappend connFlags -password $env(TDBCPOSTGRES_PASSWD)
28
}
29
if {[info exists env(TDBCPOSTGRES_DB)]} {
30
lappend connFlags -db $env(TDBCPOSTGRES_DB)
31
tcltest::testConstraint connect 1
32
} else {
33
tcltest::testConstraint connect 0
34
}
35
if {[info exists env(TDBCPOSTGRES_PORT)]} {
36
lappend connFlags -port $env(TDBCPOSTGRES_PORT)
37
}
38
39
#------------------------------------------------------------------------------
40
test tdbc::postgres-1.1 {create a connection, wrong # args} {*}{
41
-body {
42
tdbc::postgres::connection create
43
}
44
-returnCodes error
45
-match glob
46
-result {wrong # args*}
47
}
48
49
test tdbc::postgres-1.2 {create a connection, connection string missing} {*}{
50
-body {
51
tdbc::postgres::connection create db -user
52
}
53
-returnCodes error
54
-match glob
55
-result {wrong # args*}
56
}
57
58
test tdbc::postgres-1.3 {create a connection, bad arg} {*}{
59
-body {
60
tdbc::postgres::connection create db -rubbish rubbish
61
}
62
-returnCodes error
63
-match glob
64
-result {bad option "-rubbish"*}
65
}
66
67
test tdbc::postgres-1.4 {create a connection, bad port} {*}{
68
-body {
69
tdbc::postgres::connection create db -port rubbish
70
}
71
-returnCodes error
72
-result {expected integer but got "rubbish"}
73
}
74
75
test tdbc::postgres-1.5 {create a connection, bad port} {*}{
76
-body {
77
tdbc::postgres::connection create db -port 999999999999
78
}
79
-returnCodes error
80
-match glob
81
-result {integer value too large to represent*}
82
}
83
84
test tdbc::postgres-1.6 {create a connection, bad port} {*}{
85
-body {
86
tdbc::postgres::connection create db -port -1
87
}
88
-returnCodes error
89
-result {port number must be in range [0..65535]}
90
}
91
92
test tdbc::postgres-1.7 {create a connection, bad port} {*}{
93
-body {
94
tdbc::postgres::connection create db -port 65536
95
}
96
-returnCodes error
97
-result {port number must be in range [0..65535]}
98
}
99
100
test tdbc::postgres-1.8 {create a connection, failure} {*}{
101
-body {
102
set status [catch {
103
tdbc::postgres::connection create db -host rubbish.example.com
104
} result]
105
list $status $result $::errorCode
106
}
107
-match glob
108
-result {1 {could not translate host name*} {TDBC GENERAL_ERROR HY000 POSTGRES *}}
109
}
110
111
test tdbc::postgres-1.9 {create a connection, successful} {*}{
112
-constraints connect
113
-body {
114
tdbc::postgres::connection create ::db {*}$connFlags
115
}
116
-result ::db
117
-cleanup {
118
catch {rename ::db {}}
119
}
120
}
121
122
123
#------------------------------------------------------------------------------
124
#
125
# The tests that follow all require a connection to a database.
126
127
if {![tcltest::testConstraint connect]} {
128
puts "tests requiring a db connection skipped."
129
cleanupTests
130
return
131
}
132
133
tdbc::postgres::connection create ::db {*}$connFlags
134
catch {::db allrows {DROP TABLE people}}
135
136
#------------------------------------------------------------------------------
137
138
test tdbc::postgres-2.1 {prepare statement, wrong # args} {*}{
139
-body {
140
::db prepare
141
}
142
-returnCodes error
143
-match glob
144
-result {wrong # args*}
145
}
146
147
test tdbc::postgres-2.2 {don't make a statement without a connection} {*}{
148
-body {
149
tdbc::postgres::statement create stmt rubbish moreRubbish
150
}
151
-returnCodes error
152
-result {rubbish does not refer to an object}
153
}
154
155
test tdbc::postgres-2.3 {don't make a statement without a connection} {*}{
156
-body {
157
tdbc::postgres::statement create stmt oo::class moreRubbish
158
}
159
-returnCodes error
160
-result {oo::class does not refer to a Postgres connection}
161
}
162
163
test tdbc::postgres-2.4 {semicolons in statements} {*}{
164
-body {
165
::db prepare {select foo from bar; select grill from quux}
166
}
167
-returnCodes error
168
-result {tdbc::postgres does not support semicolons in statements}
169
}
170
171
test tdbc::postgres-3.1 {prepare an invalid statement} {*}{
172
-body {
173
set status [catch {
174
::db prepare {
175
RUBBISH
176
}
177
} result]
178
list $status $result $::errorCode
179
}
180
-match glob
181
-result {1 {*syntax error*} {TDBC SYNTAX_ERROR* 42601 POSTGRES *}}
182
}
183
184
test tdbc::postgres-3.2 {prepare a valid statement} {*}{
185
-body {
186
set stmt [::db prepare {
187
CREATE TABLE people(
188
idnum INTEGER PRIMARY KEY,
189
name VARCHAR(40) NOT NULL
190
)
191
}]
192
}
193
-match glob
194
-result *Stmt*
195
-cleanup {
196
catch [rename $stmt {}]
197
}
198
}
199
200
test tdbc::postgres-3.3 {execute a valid statement with no results} {*}{
201
-body {
202
set stmt [::db prepare {
203
CREATE TABLE people(
204
idnum INTEGER PRIMARY KEY,
205
name VARCHAR(40) NOT NULL
206
)
207
}]
208
set rs [$stmt execute]
209
list [expr {[$rs rowcount] <= 0}] [$rs columns] [$rs nextrow nothing]
210
}
211
-result {1 {} 0}
212
-cleanup {
213
catch {
214
rename $rs {}
215
rename $stmt {}
216
set stmt [::db prepare {
217
DROP TABLE people
218
}]
219
set rs [$stmt execute]
220
rename $rs {}
221
rename $stmt {}
222
}
223
}
224
}
225
226
test tdbc::postgres-3.4 {result set: wrong # args} {*}{
227
-body {
228
set stmt [::db prepare {
229
CREATE TABLE people(
230
idnum INTEGER PRIMARY KEY,
231
name VARCHAR(40) NOT NULL
232
)
233
}]
234
$stmt execute with extra args
235
}
236
-returnCodes error
237
-match glob
238
-result {wrong # args*}
239
-cleanup {
240
catch [rename $stmt {}]
241
}
242
}
243
244
test tdbc::postgres-3.5 {result set: trying to create against a non-object} {*}{
245
-body {
246
tdbc::postgres::resultset create rs nothing
247
}
248
-returnCodes error
249
-result {nothing does not refer to an object}
250
}
251
252
test tdbc::postgres-3.6 {result set: trying to create against a non-statement} {*}{
253
-body {
254
tdbc::postgres::resultset create rs db
255
}
256
-returnCodes error
257
-result {db does not refer to a Postgres statement}
258
}
259
260
#-------------------------------------------------------------------------------
261
#
262
# Following tests need a 'people' table in the database.
263
# They also need to use the InnoDB engine, because some of the test cases
264
# test transaction support.
265
266
set stmt [::db prepare {
267
CREATE TABLE people(
268
idnum INTEGER PRIMARY KEY,
269
name VARCHAR(40) NOT NULL,
270
info INTEGER
271
)
272
}]
273
set rs [$stmt execute]
274
rename $rs {}
275
rename $stmt {}
276
277
test tdbc::postgres-4.1 {execute an insert with no params} {*}{
278
-body {
279
set stmt [::db prepare {
280
INSERT INTO people(idnum, name, info) values(1, 'fred', 0)
281
}]
282
set rs [$stmt execute]
283
list [$rs rowcount] [$rs columns] [$rs nextrow nothing]
284
}
285
-result {1 {} 0}
286
-cleanup {
287
catch {
288
rename $rs {}
289
rename $stmt {}
290
set stmt [::db prepare {
291
DELETE FROM people
292
}]
293
set rs [$stmt execute]
294
rename $rs {}
295
rename $stmt {}
296
}
297
}
298
}
299
300
test tdbc::postgres-4.2 {execute an insert with variable parameters} {*}{
301
-body {
302
set stmt [::db prepare {
303
INSERT INTO people(idnum, name, info) values(:idnum, :name, 0)
304
}]
305
$stmt paramtype idnum integer
306
$stmt paramtype name varchar 40
307
set idnum 1
308
set name fred
309
set rs [$stmt execute]
310
list [$rs rowcount] [$rs columns] [$rs nextrow nothing]
311
}
312
-result {1 {} 0}
313
-cleanup {
314
catch {
315
rename $rs {}
316
rename $stmt {}
317
set stmt [::db prepare {
318
DELETE FROM people
319
}]
320
set rs [$stmt execute]
321
rename $rs {}
322
rename $stmt {}
323
}
324
}
325
}
326
327
test tdbc::postgres-4.3 {execute an insert with dictionary parameters} {*}{
328
-body {
329
set stmt [::db prepare {
330
INSERT INTO people(idnum, name, info) values(:idnum, :name, 0)
331
}]
332
$stmt paramtype idnum integer
333
$stmt paramtype name varchar 40
334
set rs [$stmt execute {idnum 1 name fred}]
335
list [$rs rowcount] [$rs columns] [$rs nextrow nothing]
336
}
337
-result {1 {} 0}
338
-cleanup {
339
catch {
340
rename $rs {}
341
rename $stmt {}
342
set stmt [::db prepare {
343
DELETE FROM people
344
}]
345
set rs [$stmt execute]
346
rename $rs {}
347
rename $stmt {}
348
}
349
}
350
}
351
352
test tdbc::postgres-4.4 {bad dictionary} {*}{
353
-body {
354
set stmt [::db prepare {
355
INSERT INTO people(idnum, name) values(:idnum, :name)
356
}]
357
$stmt paramtype idnum integer
358
$stmt paramtype name varchar 40
359
$stmt execute {idnum 1 name}
360
}
361
-returnCodes error
362
-result {missing value to go with key}
363
-cleanup {
364
catch {
365
rename $stmt {}
366
set stmt [::db prepare {
367
DELETE FROM people
368
}]
369
set rs [$stmt execute]
370
rename $rs {}
371
rename $stmt {}
372
}
373
}
374
}
375
376
test tdbc::postgres-4.5 {missing parameter variable} {*}{
377
-constraints !sqlite
378
-setup {
379
catch {unset idnum}
380
}
381
-body {
382
set stmt [::db prepare {
383
INSERT INTO people(idnum, name, info) values(:idnum, :name, 0)
384
}]
385
$stmt paramtype idnum integer
386
$stmt paramtype name varchar 40
387
set name fred
388
$stmt execute
389
}
390
-returnCodes error
391
-match glob
392
-result {*violates not-null constraint*}
393
-cleanup {
394
catch {
395
rename $stmt {}
396
set stmt [::db prepare {
397
DELETE FROM people
398
}]
399
set rs [$stmt execute]
400
rename $rs {}
401
rename $stmt {}
402
}
403
}
404
}
405
406
test tdbc::postgres-4.6 {missing parameter in dictionary} {*}{
407
-constraints !sqlite
408
-body {
409
set stmt [::db prepare {
410
INSERT INTO people(idnum, name, info) values(:idnum, :name, 0)
411
}]
412
$stmt paramtype idnum integer
413
$stmt paramtype name varchar 40
414
$stmt execute {name fred}
415
}
416
-returnCodes error
417
-match glob
418
-result {*violates not-null constraint*}
419
-cleanup {
420
catch {
421
rename $stmt {}
422
set stmt [::db prepare {
423
DELETE FROM people
424
}]
425
set rs [$stmt execute]
426
rename $rs {}
427
rename $stmt {}
428
}
429
}
430
}
431
432
test tdbc::postgres-4.7 {missing parameter - nullable} {*}{
433
-setup {
434
catch {unset info}
435
set stmt [::db prepare {
436
INSERT INTO people(idnum, name, info) values(:idnum, :name, :info)
437
}]
438
$stmt paramtype idnum integer
439
$stmt paramtype name varchar 40
440
$stmt paramtype info integer
441
set stmt2 [::db prepare {
442
SELECT name, info FROM people WHERE idnum = :idnum
443
}]
444
$stmt2 paramtype idnum integer
445
}
446
-body {
447
set name "mr. gravel"
448
set idnum 100
449
set rs [$stmt execute]
450
rename $rs {}
451
set rs [$stmt2 execute]
452
$rs nextrow -as dicts row
453
set row
454
}
455
-result {name {mr. gravel}}
456
-cleanup {
457
catch {rename $rs {}}
458
catch {
459
rename $stmt {}
460
rename $stmt2 {}
461
set stmt [::db prepare {
462
DELETE FROM people
463
}]
464
set rs [$stmt execute]
465
rename $rs {}
466
rename $stmt {}
467
}
468
}
469
}
470
471
test tdbc::postgres-4.8 {missing parameter in dictionary - nullable} {*}{
472
-setup {
473
set stmt [::db prepare {
474
INSERT INTO people(idnum, name, info) values(:idnum, :name, :info)
475
}]
476
$stmt paramtype idnum integer
477
$stmt paramtype name varchar 40
478
$stmt paramtype info integer
479
set stmt2 [::db prepare {
480
SELECT name, info FROM people WHERE idnum = :idnum
481
}]
482
$stmt2 paramtype idnum integer
483
}
484
-body {
485
set rs [$stmt execute {name {gary granite} idnum 200}]
486
rename $rs {}
487
set rs [$stmt2 execute {idnum 200}]
488
$rs nextrow -as dicts row
489
set row
490
}
491
-result {name {gary granite}}
492
-cleanup {
493
catch {rename $rs {}}
494
catch {
495
rename $stmt {}
496
rename $stmt2 {}
497
set stmt [::db prepare {
498
DELETE FROM people
499
}]
500
set rs [$stmt execute]
501
rename $rs {}
502
rename $stmt {}
503
}
504
}
505
}
506
507
test tdbc::postgres-4.9 {two result sets open against the same statement} {*}{
508
-body {
509
set stmt [::db prepare {
510
INSERT INTO people(idnum, name, info) values(:idnum, :name, 0)
511
}]
512
$stmt paramtype idnum integer
513
$stmt paramtype name varchar 40
514
set rs1 [$stmt execute {idnum 1 name fred}]
515
set rs2 [$stmt execute {idnum 2 name wilma}]
516
list [$rs1 rowcount] [$rs1 columns] [$rs1 nextrow nothing] \
517
[$rs2 rowcount] [$rs2 columns] [$rs2 nextrow nothing]
518
}
519
-result {1 {} 0 1 {} 0}
520
-cleanup {
521
catch {
522
rename $rs1 {}
523
rename $rs2 {}
524
rename $stmt {}
525
set stmt [::db prepare {
526
DELETE FROM people
527
}]
528
set rs [$stmt execute]
529
rename $rs {}
530
rename $stmt {}
531
}
532
}
533
}
534
535
test tdbc::postgres-4.10 {failed execution} {*}{
536
-setup {
537
set stmt [::db prepare {
538
INSERT INTO people(idnum, name, info) values(:idnum, :name, 0)
539
}]
540
$stmt paramtype idnum integer
541
$stmt paramtype name varchar 40
542
set rs [$stmt execute {idnum 1 name fred}]
543
rename $rs {}
544
}
545
-body {
546
set status [catch {$stmt execute {idnum 1 name barney}} result]
547
list $status $::errorCode
548
}
549
-cleanup {
550
rename $stmt {}
551
set stmt [::db prepare {
552
DELETE FROM people
553
}]
554
set rs [$stmt execute]
555
rename $rs {}
556
rename $stmt {}
557
}
558
-match glob
559
-result {1 {TDBC CONSTRAINT_VIOLATION 23* POSTGRES *}}
560
}
561
562
test tdbc::postgres-5.1 {paramtype - too few args} {*}{
563
-setup {
564
set stmt [::db prepare {
565
INSERT INTO people(idnum, name, info) values(:idnum, :name, 0)
566
}]
567
}
568
-body {
569
$stmt paramtype idnum
570
}
571
-cleanup {
572
rename $stmt {}
573
}
574
-returnCodes error
575
-match glob
576
-result {wrong # args*}
577
}
578
579
test tdbc::postgres-5.2 {paramtype - just a direction} {*}{
580
-setup {
581
set stmt [::db prepare {
582
INSERT INTO people(idnum, name, info) values(:idnum, :name, 0)
583
}]
584
}
585
-body {
586
$stmt paramtype idnum in
587
}
588
-cleanup {
589
rename $stmt {}
590
}
591
-returnCodes error
592
-match glob
593
-result {wrong # args*}
594
}
595
596
test tdbc::postgres-5.3 {paramtype - bad type} {*}{
597
-setup {
598
set stmt [::db prepare {
599
INSERT INTO people(idnum, name, info) values(:idnum, :name, 0)
600
}]
601
}
602
-body {
603
$stmt paramtype idnum rubbish
604
}
605
-cleanup {
606
rename $stmt {}
607
}
608
-returnCodes error
609
-match glob
610
-result {bad SQL data type "rubbish":*}
611
}
612
613
test tdbc::postgres-5.4 {paramtype - bad scale} {*}{
614
-setup {
615
set stmt [::db prepare {
616
INSERT INTO people(idnum, name, info) values(:idnum, :name, 0)
617
}]
618
}
619
-body {
620
$stmt paramtype idnum decimal rubbish
621
}
622
-cleanup {
623
rename $stmt {}
624
}
625
-returnCodes error
626
-match glob
627
-result {expected integer but got "rubbish"}
628
}
629
630
test tdbc::postgres-5.5 {paramtype - bad precision} {*}{
631
-setup {
632
set stmt [::db prepare {
633
INSERT INTO people(idnum, name, info) values(:idnum, :name, 0)
634
}]
635
}
636
-body {
637
$stmt paramtype idnum decimal 12 rubbish
638
}
639
-cleanup {
640
rename $stmt {}
641
}
642
-returnCodes error
643
-match glob
644
-result {expected integer but got "rubbish"}
645
}
646
647
test tdbc::postgres-5.6 {paramtype - unknown parameter} {*}{
648
-setup {
649
set stmt [::db prepare {
650
INSERT INTO people(idnum, name, info) values(:idnum, :name, 0)
651
}]
652
}
653
-body {
654
$stmt paramtype rubbish integer
655
}
656
-cleanup {
657
rename $stmt {}
658
}
659
-returnCodes error
660
-match glob
661
-result {unknown parameter "rubbish":*}
662
}
663
664
test tdbc::postgres-6.1 {rowcount - wrong args} {*}{
665
-setup {
666
set stmt [::db prepare {
667
INSERT INTO people(idnum, name, info) values(:idnum, :name, 0)
668
}]
669
$stmt paramtype idnum integer
670
$stmt paramtype name varchar 40
671
set rs [$stmt execute {idnum 1 name fred}]
672
}
673
-body {
674
$rs rowcount rubbish
675
}
676
-cleanup {
677
rename $rs {}
678
rename $stmt {}
679
set stmt [::db prepare {
680
DELETE FROM people
681
}]
682
set rs [$stmt execute]
683
rename $rs {}
684
rename $stmt {}
685
}
686
-returnCodes error
687
-match glob
688
-result "wrong \# args*"
689
}
690
691
692
#-------------------------------------------------------------------------------
693
#
694
# next tests require data in the database
695
696
catch {
697
set stmt [db prepare {
698
INSERT INTO people(idnum, name, info) VALUES(:idnum, :name, NULL)
699
}]
700
$stmt paramtype idnum integer
701
$stmt paramtype name varchar 40
702
set idnum 1
703
foreach name {fred wilma pebbles barney betty bam-bam} {
704
set rs [$stmt execute]
705
rename $rs {}
706
incr idnum
707
}
708
rename $stmt {}
709
}
710
711
#-------------------------------------------------------------------------------
712
713
test tdbc::postgres-7.1 {columns - bad args} {*}{
714
-setup {
715
set stmt [::db prepare {
716
SELECT * FROM people
717
}]
718
set rs [$stmt execute]
719
}
720
-body {
721
$rs columns rubbish
722
}
723
-cleanup {
724
rename $rs {}
725
rename $stmt {}
726
}
727
-returnCodes error
728
-match glob
729
-result {wrong # args*}
730
}
731
732
test tdbc::postgres-7.2 {columns - get column names} {*}{
733
-setup {
734
set stmt [::db prepare {
735
SELECT * FROM people
736
}]
737
set rs [$stmt execute]
738
}
739
-body {
740
$rs columns
741
}
742
-cleanup {
743
rename $rs {}
744
rename $stmt {}
745
}
746
-result {idnum name info}
747
}
748
749
750
test tdbc::postgres-8.1 {nextrow - as dicts} {*}{
751
-setup {
752
set stmt [::db prepare {
753
SELECT idnum, name FROM people ORDER BY idnum
754
}]
755
set rs [$stmt execute]
756
}
757
-body {
758
set idnum 1
759
set names {}
760
while {[$rs nextrow -- row]} {
761
if {$idnum != [dict get $row idnum]} {
762
error [list bad idnum [dict get $row idnum] should be $idnum]
763
}
764
lappend names [dict get $row name]
765
incr idnum
766
}
767
set names
768
}
769
-cleanup {
770
rename $rs {}
771
rename $stmt {}
772
}
773
-result {fred wilma pebbles barney betty bam-bam}
774
}
775
776
test tdbc::postgres-8.4 {anonymous columns - dicts} {*}{
777
-setup {
778
set stmt [::db prepare {
779
SELECT COUNT(*), MAX(idnum) FROM people
780
}]
781
set rs [$stmt execute]
782
}
783
-body {
784
list \
785
[$rs nextrow row] \
786
$row \
787
[$rs nextrow row]
788
}
789
-cleanup {
790
$stmt close
791
}
792
-match glob
793
-result {1 {* 6 * 6} 0}
794
};
795
796
test tdbc::postgres-8.5 {anonymous columns - lists} {*}{
797
-setup {
798
set stmt [::db prepare {
799
SELECT COUNT(*), MAX(idnum) FROM people
800
}]
801
set rs [$stmt execute]
802
}
803
-body {
804
list [$rs nextrow -as lists row] \
805
$row \
806
[$rs nextrow -as lists row]
807
}
808
-cleanup {
809
$stmt close
810
}
811
-result {1 {6 6} 0}
812
};
813
814
815
test tdbc::postgres-8.2 {nextrow - as lists} {*}{
816
-setup {
817
set stmt [::db prepare {
818
SELECT idnum, name FROM people ORDER BY idnum
819
}]
820
set rs [$stmt execute]
821
}
822
-body {
823
set idnum 1
824
set names {}
825
while {[$rs nextrow -as lists -- row]} {
826
if {$idnum != [lindex $row 0]} {
827
error [list bad idnum [lindex $row 0] should be $idnum]
828
}
829
lappend names [lindex $row 1]
830
incr idnum
831
}
832
set names
833
}
834
-cleanup {
835
rename $rs {}
836
rename $stmt {}
837
}
838
-result {fred wilma pebbles barney betty bam-bam}
839
}
840
841
842
843
844
845
846
test tdbc::postgres-8.3 {nextrow - bad cursor state} {*}{
847
-setup {
848
set stmt [::db prepare {
849
SELECT idnum, name FROM people ORDER BY idnum
850
}]
851
}
852
-body {
853
set rs [$stmt execute]
854
set names {}
855
while {[$rs nextrow row]} {}
856
$rs nextrow row
857
}
858
-cleanup {
859
rename $rs {}
860
rename $stmt {}
861
}
862
-result 0
863
}
864
865
test tdbc::postgres-8.6 {null results - dicts} {*}{
866
-setup {
867
set stmt [::db prepare {
868
SELECT idnum, name, info FROM people WHERE name = 'fred'
869
}]
870
set rs [$stmt execute]
871
}
872
-body {
873
list [$rs nextrow row] $row [$rs nextrow row]
874
}
875
-cleanup {
876
$stmt close
877
}
878
-result {1 {idnum 1 name fred} 0}
879
}
880
881
test tdbc::postgres-8.7 {null results - lists} {*}{
882
-setup {
883
set stmt [::db prepare {
884
SELECT idnum, name, info FROM people WHERE name = 'fred'
885
}]
886
set rs [$stmt execute]
887
}
888
-body {
889
list [$rs nextrow -as lists -- row] $row [$rs nextrow -as lists -- row]
890
}
891
-cleanup {
892
$stmt close
893
}
894
-result {1 {1 fred {}} 0}
895
}
896
897
test tdbc::postgres-9.1 {rs foreach var script} {*}{
898
-setup {
899
set stmt [::db prepare {
900
SELECT idnum, name FROM people WHERE name LIKE 'b%'
901
}]
902
set rs [$stmt execute]
903
}
904
-body {
905
set result {}
906
$rs foreach row {
907
lappend result $row
908
}
909
set result
910
}
911
-cleanup {
912
$rs close
913
$stmt close
914
}
915
-result {{idnum 4 name barney} {idnum 5 name betty} {idnum 6 name bam-bam}}
916
}
917
918
test tdbc::postgres-9.2 {stmt foreach var script} {*}{
919
-setup {
920
set stmt [::db prepare {
921
SELECT idnum, name FROM people WHERE name LIKE 'b%'
922
}]
923
924
}
925
-body {
926
set result {}
927
$stmt foreach row {
928
lappend result $row
929
}
930
set result
931
}
932
-cleanup {
933
$stmt close
934
}
935
-result {{idnum 4 name barney} {idnum 5 name betty} {idnum 6 name bam-bam}}
936
}
937
938
test tdbc::postgres-9.3 {db foreach var sqlcode script} {*}{
939
-body {
940
set result {}
941
db foreach row {
942
SELECT idnum, name FROM people WHERE name LIKE 'b%'
943
} {
944
lappend result $row
945
}
946
set result
947
}
948
-result {{idnum 4 name barney} {idnum 5 name betty} {idnum 6 name bam-bam}}
949
}
950
951
test tdbc::postgres-9.4 {rs foreach -- var script} {*}{
952
-setup {
953
set stmt [::db prepare {
954
SELECT idnum, name FROM people WHERE name LIKE 'b%'
955
}]
956
set rs [$stmt execute]
957
}
958
-body {
959
set result {}
960
$rs foreach -- row {
961
lappend result $row
962
}
963
set result
964
}
965
-cleanup {
966
$rs close
967
$stmt close
968
}
969
-result {{idnum 4 name barney} {idnum 5 name betty} {idnum 6 name bam-bam}}
970
}
971
972
test tdbc::postgres-9.5 {stmt foreach -- var script} {*}{
973
-setup {
974
set stmt [::db prepare {
975
SELECT idnum, name FROM people WHERE name LIKE 'b%'
976
}]
977
}
978
-body {
979
set result {}
980
$stmt foreach -- row {
981
lappend result $row
982
}
983
set result
984
}
985
-cleanup {
986
$stmt close
987
}
988
-result {{idnum 4 name barney} {idnum 5 name betty} {idnum 6 name bam-bam}}
989
}
990
991
test tdbc::postgres-9.6 {db foreach -- var query script} {*}{
992
-body {
993
set result {}
994
db foreach -- row {
995
SELECT idnum, name FROM people WHERE name LIKE 'b%'
996
} {
997
lappend result $row
998
}
999
set result
1000
}
1001
-result {{idnum 4 name barney} {idnum 5 name betty} {idnum 6 name bam-bam}}
1002
}
1003
1004
test tdbc::postgres-9.7 {rs foreach -- -as lists} {*}{
1005
-setup {
1006
set stmt [::db prepare {
1007
SELECT idnum, name, info FROM people WHERE name LIKE 'b%'
1008
}]
1009
set rs [$stmt execute]
1010
}
1011
-body {
1012
set result {}
1013
$rs foreach -as lists row {
1014
lappend result $row
1015
}
1016
set result
1017
}
1018
-cleanup {
1019
$rs close
1020
$stmt close
1021
}
1022
-result {{4 barney {}} {5 betty {}} {6 bam-bam {}}}
1023
}
1024
1025
test tdbc::postgres-9.8 {stmt foreach -as lists} {*}{
1026
-setup {
1027
set stmt [::db prepare {
1028
SELECT idnum, name, info FROM people WHERE name LIKE 'b%'
1029
}]
1030
}
1031
-body {
1032
set result {}
1033
$stmt foreach -as lists row {
1034
lappend result $row
1035
}
1036
set result
1037
}
1038
-cleanup {
1039
$stmt close
1040
}
1041
-result {{4 barney {}} {5 betty {}} {6 bam-bam {}}}
1042
}
1043
1044
test tdbc::postgres-9.9 {db foreach -as lists} {*}{
1045
-body {
1046
set result {}
1047
db foreach -as lists row {
1048
SELECT idnum, name, info FROM people WHERE name LIKE 'b%'
1049
} {
1050
lappend result $row
1051
}
1052
set result
1053
}
1054
-result {{4 barney {}} {5 betty {}} {6 bam-bam {}}}
1055
}
1056
1057
test tdbc::postgres-9.10 {rs foreach -as lists --} {*}{
1058
-setup {
1059
set stmt [::db prepare {
1060
SELECT idnum, name, info FROM people WHERE name LIKE 'b%'
1061
}]
1062
set rs [$stmt execute]
1063
}
1064
-body {
1065
set result {}
1066
$rs foreach -as lists -- row {
1067
lappend result $row
1068
}
1069
set result
1070
}
1071
-cleanup {
1072
$rs close
1073
$stmt close
1074
}
1075
-result {{4 barney {}} {5 betty {}} {6 bam-bam {}}}
1076
}
1077
1078
test tdbc::postgres-9.11 {stmt foreach -as lists --} {*}{
1079
-setup {
1080
set stmt [::db prepare {
1081
SELECT idnum, name, info FROM people WHERE name LIKE 'b%'
1082
}]
1083
}
1084
-body {
1085
set result {}
1086
$stmt foreach -as lists -- row {
1087
lappend result $row
1088
}
1089
set result
1090
}
1091
-cleanup {
1092
$stmt close
1093
}
1094
-result {{4 barney {}} {5 betty {}} {6 bam-bam {}}}
1095
}
1096
1097
test tdbc::postgres-9.12 {db foreach -as lists --} {*}{
1098
-body {
1099
set result {}
1100
db foreach -as lists row {
1101
SELECT idnum, name, info FROM people WHERE name LIKE 'b%'
1102
} {
1103
lappend result $row
1104
}
1105
set result
1106
}
1107
-result {{4 barney {}} {5 betty {}} {6 bam-bam {}}}
1108
}
1109
1110
test tdbc::postgres-9.13 {rs foreach -as lists -columnsvar c --} {*}{
1111
-setup {
1112
set stmt [::db prepare {
1113
SELECT idnum, name FROM people WHERE name LIKE 'b%'
1114
}]
1115
set rs [$stmt execute]
1116
}
1117
-body {
1118
set result {}
1119
$rs foreach -as lists -columnsvar c -- row {
1120
foreach cn $c cv $row {
1121
lappend result $cn $cv
1122
}
1123
}
1124
set result
1125
}
1126
-cleanup {
1127
$rs close
1128
$stmt close
1129
}
1130
-result {idnum 4 name barney idnum 5 name betty idnum 6 name bam-bam}
1131
}
1132
1133
test tdbc::postgres-9.14 {stmt foreach -as lists -columnsvar c --} {*}{
1134
-setup {
1135
set stmt [::db prepare {
1136
SELECT idnum, name FROM people WHERE name LIKE 'b%'
1137
}]
1138
}
1139
-body {
1140
set result {}
1141
$stmt foreach -as lists -columnsvar c -- row {
1142
foreach cn $c cv $row {
1143
lappend result $cn $cv
1144
}
1145
}
1146
set result
1147
}
1148
-cleanup {
1149
$stmt close
1150
}
1151
-result {idnum 4 name barney idnum 5 name betty idnum 6 name bam-bam}
1152
}
1153
1154
test tdbc::postgres-9.15 {db foreach -as lists -columnsvar c --} {*}{
1155
-body {
1156
set result {}
1157
db foreach -as lists -columnsvar c -- row {
1158
SELECT idnum, name FROM people WHERE name LIKE 'b%'
1159
} {
1160
foreach cn $c cv $row {
1161
lappend result $cn $cv
1162
}
1163
}
1164
set result
1165
}
1166
-result {idnum 4 name barney idnum 5 name betty idnum 6 name bam-bam}
1167
}
1168
1169
test tdbc::postgres-9.16 {rs foreach / break out of loop} {*}{
1170
-setup {
1171
set stmt [::db prepare {
1172
SELECT idnum, name, info FROM people WHERE name LIKE 'b%'
1173
}]
1174
set rs [$stmt execute]
1175
}
1176
-body {
1177
set result {}
1178
$rs foreach -as lists -- row {
1179
if {[lindex $row 1] eq {betty}} break
1180
lappend result $row
1181
}
1182
set result
1183
}
1184
-cleanup {
1185
$rs close
1186
$stmt close
1187
}
1188
-result {{4 barney {}}}
1189
}
1190
1191
test tdbc::postgres-9.17 {stmt foreach / break out of loop} {*}{
1192
-setup {
1193
set stmt [::db prepare {
1194
SELECT idnum, name, info FROM people WHERE name LIKE 'b%'
1195
}]
1196
}
1197
-body {
1198
set result {}
1199
$stmt foreach -as lists -- row {
1200
if {[lindex $row 1] eq {betty}} break
1201
lappend result $row
1202
}
1203
set result
1204
}
1205
-cleanup {
1206
$stmt close
1207
}
1208
-result {{4 barney {}}}
1209
}
1210
1211
test tdbc::postgres-9.18 {db foreach / break out of loop} {*}{
1212
-body {
1213
set result {}
1214
db foreach -as lists -- row {
1215
SELECT idnum, name, info FROM people WHERE name LIKE 'b%'
1216
} {
1217
if {[lindex $row 1] eq {betty}} break
1218
lappend result $row
1219
}
1220
set result
1221
}
1222
-result {{4 barney {}}}
1223
}
1224
1225
test tdbc::postgres-9.19 {rs foreach / continue in loop} {*}{
1226
-setup {
1227
set stmt [::db prepare {
1228
SELECT idnum, name, info FROM people WHERE name LIKE 'b%'
1229
}]
1230
set rs [$stmt execute]
1231
}
1232
-body {
1233
set result {}
1234
$rs foreach -as lists -- row {
1235
if {[lindex $row 1] eq {betty}} continue
1236
lappend result $row
1237
}
1238
set result
1239
}
1240
-cleanup {
1241
$rs close
1242
$stmt close
1243
}
1244
-result {{4 barney {}} {6 bam-bam {}}}
1245
}
1246
1247
test tdbc::postgres-9.20 {stmt foreach / continue in loop} {*}{
1248
-setup {
1249
set stmt [::db prepare {
1250
SELECT idnum, name, info FROM people WHERE name LIKE 'b%'
1251
}]
1252
}
1253
-body {
1254
set result {}
1255
$stmt foreach -as lists -- row {
1256
if {[lindex $row 1] eq {betty}} continue
1257
lappend result $row
1258
}
1259
set result
1260
}
1261
-cleanup {
1262
$stmt close
1263
}
1264
-result {{4 barney {}} {6 bam-bam {}}}
1265
}
1266
1267
test tdbc::postgres-9.21 {db foreach / continue in loop} {*}{
1268
-body {
1269
set result {}
1270
db foreach -as lists -- row {
1271
SELECT idnum, name, info FROM people WHERE name LIKE 'b%'
1272
} {
1273
if {[lindex $row 1] eq {betty}} continue
1274
lappend result $row
1275
}
1276
set result
1277
}
1278
-result {{4 barney {}} {6 bam-bam {}}}
1279
}
1280
1281
test tdbc::postgres-9.22 {rs foreach / return out of the loop} {*}{
1282
-setup {
1283
set stmt [::db prepare {
1284
SELECT idnum, name FROM people WHERE name LIKE 'b%'
1285
}]
1286
set rs [$stmt execute]
1287
proc tdbcpostgres-9.22 {rs} {
1288
$rs foreach -as lists -- row {
1289
if {[lindex $row 1] eq {betty}} {
1290
return [lindex $row 0]
1291
}
1292
}
1293
return failed
1294
}
1295
}
1296
-body {
1297
tdbcpostgres-9.22 $rs
1298
}
1299
-cleanup {
1300
rename tdbcpostgres-9.22 {}
1301
rename $rs {}
1302
rename $stmt {}
1303
}
1304
-result 5
1305
}
1306
1307
test tdbc::postgres-9.23 {stmt foreach / return out of the loop} {*}{
1308
-setup {
1309
set stmt [::db prepare {
1310
SELECT idnum, name FROM people WHERE name LIKE 'b%'
1311
}]
1312
proc tdbcpostgres-9.23 {stmt} {
1313
$stmt foreach -as lists -- row {
1314
if {[lindex $row 1] eq {betty}} {
1315
return [lindex $row 0]
1316
}
1317
}
1318
return failed
1319
}
1320
}
1321
-body {
1322
tdbcpostgres-9.23 $stmt
1323
}
1324
-cleanup {
1325
rename tdbcpostgres-9.23 {}
1326
rename $stmt {}
1327
}
1328
-result 5
1329
}
1330
1331
test tdbc::postgres-9.24 {db foreach / return out of the loop} {*}{
1332
-setup {
1333
proc tdbcpostgres-9.24 {stmt} {
1334
db foreach -as lists -- row {
1335
SELECT idnum, name FROM people WHERE name LIKE 'b%'
1336
} {
1337
if {[lindex $row 1] eq {betty}} {
1338
return [lindex $row 0]
1339
}
1340
}
1341
return failed
1342
}
1343
}
1344
-body {
1345
tdbcpostgres-9.24 $stmt
1346
}
1347
-cleanup {
1348
rename tdbcpostgres-9.24 {}
1349
}
1350
-result 5
1351
}
1352
1353
test tdbc::postgres-9.25 {rs foreach / error out of the loop} {*}{
1354
-setup {
1355
set stmt [::db prepare {
1356
SELECT idnum, name FROM people WHERE name LIKE 'b%'
1357
}]
1358
set rs [$stmt execute]
1359
proc tdbcpostgres-9.25 {rs} {
1360
$rs foreach -as lists -- row {
1361
if {[lindex $row 1] eq {betty}} {
1362
error [lindex $row 0]
1363
}
1364
}
1365
return failed
1366
}
1367
}
1368
-body {
1369
tdbcpostgres-9.25 $rs
1370
}
1371
-cleanup {
1372
rename tdbcpostgres-9.25 {}
1373
rename $rs {}
1374
rename $stmt {}
1375
}
1376
-returnCodes error
1377
-result 5
1378
}
1379
1380
test tdbc::postgres-9.26 {stmt foreach - error out of the loop} {*}{
1381
-setup {
1382
set stmt [::db prepare {
1383
SELECT idnum, name FROM people WHERE name LIKE 'b%'
1384
}]
1385
proc tdbcpostgres-9.26 {stmt} {
1386
$stmt foreach -as lists -- row {
1387
if {[lindex $row 1] eq {betty}} {
1388
error [lindex $row 0]
1389
}
1390
}
1391
return failed
1392
}
1393
}
1394
-body {
1395
tdbcpostgres-9.26 $stmt
1396
}
1397
-cleanup {
1398
rename tdbcpostgres-9.26 {}
1399
rename $stmt {}
1400
}
1401
-returnCodes error
1402
-result 5
1403
}
1404
1405
test tdbc::postgres-9.27 {db foreach / error out of the loop} {*}{
1406
-setup {
1407
proc tdbcpostgres-9.27 {} {
1408
db foreach -as lists -- row {
1409
SELECT idnum, name FROM people WHERE name LIKE 'b%'
1410
} {
1411
if {[lindex $row 1] eq {betty}} {
1412
error [lindex $row 0]
1413
}
1414
}
1415
return failed
1416
}
1417
}
1418
-body {
1419
tdbcpostgres-9.27
1420
}
1421
-cleanup {
1422
rename tdbcpostgres-9.27 {}
1423
}
1424
-returnCodes error
1425
-result 5
1426
}
1427
1428
test tdbc::postgres-9.28 {rs foreach / unknown status from the loop} {*}{
1429
-setup {
1430
set stmt [::db prepare {
1431
SELECT idnum, name FROM people WHERE name LIKE 'b%'
1432
}]
1433
set rs [$stmt execute]
1434
proc tdbcpostgres-9.28 {rs} {
1435
$rs foreach -as lists -- row {
1436
if {[lindex $row 1] eq {betty}} {
1437
return -code 666 -level 0 [lindex $row 0]
1438
}
1439
}
1440
return failed
1441
}
1442
}
1443
-body {
1444
tdbcpostgres-9.28 $rs
1445
}
1446
-cleanup {
1447
rename tdbcpostgres-9.28 {}
1448
rename $rs {}
1449
rename $stmt {}
1450
}
1451
-returnCodes 666
1452
-result 5
1453
}
1454
1455
test tdbc::postgres-9.29 {stmt foreach / unknown status from the loop} {*}{
1456
-setup {
1457
set stmt [::db prepare {
1458
SELECT idnum, name FROM people WHERE name LIKE 'b%'
1459
}]
1460
proc tdbcpostgres-9.29 {stmt} {
1461
$stmt foreach -as lists -- row {
1462
if {[lindex $row 1] eq {betty}} {
1463
return -code 666 -level 0 [lindex $row 0]
1464
}
1465
}
1466
return failed
1467
}
1468
}
1469
-body {
1470
tdbcpostgres-9.29 $stmt
1471
}
1472
-cleanup {
1473
rename tdbcpostgres-9.29 {}
1474
rename $stmt {}
1475
}
1476
-returnCodes 666
1477
-result 5
1478
}
1479
1480
test tdbc::postgres-9.30 {db foreach / unknown status from the loop} {*}{
1481
-setup {
1482
proc tdbcpostgres-9.30 {stmt} {
1483
db foreach -as lists -- row {
1484
SELECT idnum, name FROM people WHERE name LIKE 'b%'
1485
} {
1486
if {[lindex $row 1] eq {betty}} {
1487
return -code 666 -level 0 [lindex $row 0]
1488
}
1489
}
1490
return failed
1491
}
1492
}
1493
-body {
1494
tdbcpostgres-9.30 $stmt
1495
}
1496
-cleanup {
1497
rename tdbcpostgres-9.30 {}
1498
}
1499
-returnCodes 666
1500
-result 5
1501
}
1502
1503
1504
test tdbc::postgres-9.31 {stmt foreach / params in variables} {*}{
1505
-setup {
1506
set stmt [::db prepare {
1507
SELECT idnum, name FROM people WHERE name LIKE :thePattern
1508
}]
1509
$stmt paramtype thePattern varchar 40
1510
}
1511
-body {
1512
set result {}
1513
set thePattern b%
1514
$stmt foreach row {
1515
lappend result $row
1516
}
1517
set result
1518
}
1519
-cleanup {
1520
$stmt close
1521
}
1522
-result {{idnum 4 name barney} {idnum 5 name betty} {idnum 6 name bam-bam}}
1523
}
1524
1525
test tdbc::postgres-9.32 {db foreach / params in variables} {*}{
1526
-body {
1527
set result {}
1528
set thePattern b%
1529
db foreach row {
1530
SELECT idnum, name FROM people WHERE name LIKE :thePattern
1531
} {
1532
lappend result $row
1533
}
1534
set result
1535
}
1536
-result {{idnum 4 name barney} {idnum 5 name betty} {idnum 6 name bam-bam}}
1537
}
1538
1539
test tdbc::postgres-9.33 {stmt foreach / parameters in a dictionary} {*}{
1540
-setup {
1541
set stmt [::db prepare {
1542
SELECT idnum, name FROM people WHERE name LIKE :thePattern
1543
}]
1544
$stmt paramtype thePattern varchar 40
1545
}
1546
-body {
1547
set result {}
1548
$stmt foreach row {thePattern b%} {
1549
lappend result $row
1550
}
1551
set result
1552
}
1553
-cleanup {
1554
$stmt close
1555
}
1556
-result {{idnum 4 name barney} {idnum 5 name betty} {idnum 6 name bam-bam}}
1557
}
1558
1559
test tdbc::postgres-9.34 {db foreach / parameters in a dictionary} {*}{
1560
-body {
1561
set result {}
1562
db foreach row {
1563
SELECT idnum, name FROM people WHERE name LIKE :thePattern
1564
} {thePattern b%} {
1565
lappend result $row
1566
}
1567
set result
1568
}
1569
-result {{idnum 4 name barney} {idnum 5 name betty} {idnum 6 name bam-bam}}
1570
}
1571
1572
test tdbc::postgres-9.35 {stmt foreach - variable not found} {*}{
1573
-setup {
1574
set stmt [::db prepare {
1575
SELECT idnum, name FROM people WHERE name LIKE :thePattern
1576
}]
1577
$stmt paramtype thePattern varchar 40
1578
catch {unset thePattern}
1579
}
1580
-body {
1581
set result {}
1582
set thePattern(bogosity) {}
1583
$stmt foreach row {
1584
lappend result $row
1585
}
1586
set result
1587
}
1588
-cleanup {
1589
unset thePattern
1590
$stmt close
1591
}
1592
-result {}
1593
}
1594
1595
test tdbc::postgres-9.36 {db foreach - variable not found} {*}{
1596
-setup {
1597
catch {unset thePattern}
1598
}
1599
-body {
1600
set result {}
1601
set thePattern(bogosity) {}
1602
db foreach row {
1603
SELECT idnum, name FROM people WHERE name LIKE :thePattern
1604
} {
1605
lappend result $row
1606
}
1607
set result
1608
}
1609
-cleanup {
1610
unset thePattern
1611
}
1612
-result {}
1613
}
1614
1615
test tdbc::postgres-9.37 {rs foreach - too few args} {*}{
1616
-setup {
1617
set stmt [::db prepare {
1618
SELECT idnum, name FROM people
1619
}]
1620
set rs [$stmt execute]
1621
}
1622
-body {
1623
$rs foreach row
1624
}
1625
-cleanup {
1626
$rs close
1627
$stmt close
1628
}
1629
-returnCodes error
1630
-result {wrong # args*}
1631
-match glob
1632
}
1633
1634
test tdbc::postgres-9.38 {stmt foreach - too few args} {*}{
1635
-setup {
1636
set stmt [::db prepare {
1637
SELECT idnum, name FROM people
1638
}]
1639
}
1640
-body {
1641
$stmt foreach row
1642
}
1643
-cleanup {
1644
$stmt close
1645
}
1646
-returnCodes error
1647
-result {wrong # args*}
1648
-match glob
1649
}
1650
1651
test tdbc::postgres-9.39 {db foreach - too few args} {*}{
1652
-body {
1653
db foreach row {
1654
SELECT idnum, name FROM people
1655
}
1656
}
1657
-returnCodes error
1658
-result {wrong # args*}
1659
-match glob
1660
}
1661
1662
test tdbc::postgres-9.40 {rs foreach - too many args} {*}{
1663
-setup {
1664
set stmt [::db prepare {
1665
SELECT idnum, name FROM people
1666
}]
1667
set rs [$stmt execute]
1668
}
1669
-body {
1670
$rs foreach row do something
1671
}
1672
-cleanup {
1673
$rs close
1674
$stmt close
1675
}
1676
-returnCodes error
1677
-result {wrong # args*}
1678
-match glob
1679
}
1680
1681
test tdbc::postgres-9.41 {stmt foreach - too many args} {*}{
1682
-setup {
1683
set stmt [::db prepare {
1684
SELECT idnum, name FROM people
1685
}]
1686
}
1687
-body {
1688
$stmt foreach row do something else
1689
}
1690
-cleanup {
1691
$stmt close
1692
}
1693
-returnCodes error
1694
-result {wrong # args*}
1695
-match glob
1696
}
1697
1698
test tdbc::postgres-9.42 {db foreach - too many args} {*}{
1699
-body {
1700
db foreach row {
1701
SELECT idnum, name FROM people
1702
} {} do something
1703
}
1704
-returnCodes error
1705
-result {wrong # args*}
1706
-match glob
1707
}
1708
1709
test tdbc::postgres-10.1 {allrows - no args} {*}{
1710
-setup {
1711
set stmt [::db prepare {
1712
SELECT idnum, name FROM people WHERE name LIKE 'b%'
1713
}]
1714
set rs [$stmt execute]
1715
}
1716
-body {
1717
$rs allrows
1718
}
1719
-cleanup {
1720
rename $rs {}
1721
rename $stmt {}
1722
}
1723
-result {{idnum 4 name barney} {idnum 5 name betty} {idnum 6 name bam-bam}}
1724
}
1725
1726
test tdbc::postgres-10.2 {allrows - no args} {*}{
1727
-setup {
1728
set stmt [::db prepare {
1729
SELECT idnum, name FROM people WHERE name LIKE 'b%'
1730
}]
1731
}
1732
-body {
1733
$stmt allrows
1734
}
1735
-cleanup {
1736
rename $stmt {}
1737
}
1738
-result {{idnum 4 name barney} {idnum 5 name betty} {idnum 6 name bam-bam}}
1739
}
1740
1741
test tdbc::postgres-10.3 {allrows - no args} {*}{
1742
-body {
1743
db allrows {
1744
SELECT idnum, name FROM people WHERE name LIKE 'b%'
1745
}
1746
}
1747
-result {{idnum 4 name barney} {idnum 5 name betty} {idnum 6 name bam-bam}}
1748
}
1749
1750
test tdbc::postgres-10.4 {allrows --} {*}{
1751
-setup {
1752
set stmt [::db prepare {
1753
SELECT idnum, name FROM people WHERE name LIKE 'b%'
1754
}]
1755
set rs [$stmt execute]
1756
}
1757
-body {
1758
$rs allrows --
1759
}
1760
-cleanup {
1761
rename $rs {}
1762
rename $stmt {}
1763
}
1764
-result {{idnum 4 name barney} {idnum 5 name betty} {idnum 6 name bam-bam}}
1765
}
1766
1767
test tdbc::postgres-10.5 {allrows --} {*}{
1768
-setup {
1769
set stmt [::db prepare {
1770
SELECT idnum, name FROM people WHERE name LIKE 'b%'
1771
}]
1772
}
1773
-body {
1774
$stmt allrows --
1775
}
1776
-cleanup {
1777
rename $stmt {}
1778
}
1779
-result {{idnum 4 name barney} {idnum 5 name betty} {idnum 6 name bam-bam}}
1780
}
1781
1782
test tdbc::postgres-10.6 {allrows --} {*}{
1783
-body {
1784
db allrows -- {
1785
SELECT idnum, name FROM people WHERE name LIKE 'b%'
1786
}
1787
}
1788
-result {{idnum 4 name barney} {idnum 5 name betty} {idnum 6 name bam-bam}}
1789
}
1790
1791
test tdbc::postgres-10.7 {allrows -as lists} {*}{
1792
-setup {
1793
set stmt [::db prepare {
1794
SELECT idnum, name FROM people WHERE name LIKE 'b%'
1795
}]
1796
set rs [$stmt execute]
1797
}
1798
-body {
1799
$rs allrows -as lists
1800
}
1801
-cleanup {
1802
rename $rs {}
1803
rename $stmt {}
1804
}
1805
-result {{4 barney} {5 betty} {6 bam-bam}}
1806
}
1807
1808
test tdbc::postgres-10.8 {allrows -as lists} {*}{
1809
-setup {
1810
set stmt [::db prepare {
1811
SELECT idnum, name FROM people WHERE name LIKE 'b%'
1812
}]
1813
}
1814
-body {
1815
$stmt allrows -as lists
1816
}
1817
-cleanup {
1818
rename $stmt {}
1819
}
1820
-result {{4 barney} {5 betty} {6 bam-bam}}
1821
}
1822
1823
test tdbc::postgres-10.9 {allrows -as lists} {*}{
1824
-body {
1825
db allrows -as lists {
1826
SELECT idnum, name FROM people WHERE name LIKE 'b%'
1827
}
1828
}
1829
-result {{4 barney} {5 betty} {6 bam-bam}}
1830
}
1831
1832
test tdbc::postgres-10.10 {allrows -as lists --} {*}{
1833
-setup {
1834
set stmt [::db prepare {
1835
SELECT idnum, name FROM people WHERE name LIKE 'b%'
1836
}]
1837
set rs [$stmt execute]
1838
}
1839
-body {
1840
$rs allrows -as lists --
1841
}
1842
-cleanup {
1843
rename $rs {}
1844
rename $stmt {}
1845
}
1846
-result {{4 barney} {5 betty} {6 bam-bam}}
1847
}
1848
1849
test tdbc::postgres-10.11 {allrows -as lists --} {*}{
1850
-setup {
1851
set stmt [::db prepare {
1852
SELECT idnum, name FROM people WHERE name LIKE 'b%'
1853
}]
1854
}
1855
-body {
1856
$stmt allrows -as lists --
1857
}
1858
-cleanup {
1859
rename $stmt {}
1860
}
1861
-result {{4 barney} {5 betty} {6 bam-bam}}
1862
}
1863
1864
test tdbc::postgres-10.12 {allrows -as lists --} {*}{
1865
-body {
1866
db allrows -as lists -- {
1867
SELECT idnum, name FROM people WHERE name LIKE 'b%'
1868
}
1869
}
1870
-result {{4 barney} {5 betty} {6 bam-bam}}
1871
}
1872
1873
test tdbc::postgres-10.13 {allrows -as lists -columnsvar c} {*}{
1874
-setup {
1875
set stmt [::db prepare {
1876
SELECT idnum, name FROM people WHERE name LIKE 'b%'
1877
}]
1878
set rs [$stmt execute]
1879
}
1880
-body {
1881
set result [$rs allrows -as lists -columnsvar c]
1882
list $c $result
1883
}
1884
-cleanup {
1885
rename $rs {}
1886
rename $stmt {}
1887
}
1888
-result {{idnum name} {{4 barney} {5 betty} {6 bam-bam}}}
1889
}
1890
1891
test tdbc::postgres-10.14 {allrows -as lists -columnsvar c} {*}{
1892
-setup {
1893
set stmt [::db prepare {
1894
SELECT idnum, name FROM people WHERE name LIKE 'b%'
1895
}]
1896
}
1897
-body {
1898
set result [$stmt allrows -as lists -columnsvar c]
1899
list $c $result
1900
}
1901
-cleanup {
1902
rename $stmt {}
1903
}
1904
-result {{idnum name} {{4 barney} {5 betty} {6 bam-bam}}}
1905
}
1906
1907
test tdbc::postgres-10.15 {allrows -as lists -columnsvar c} {*}{
1908
-body {
1909
set result [db allrows -as lists -columnsvar c {
1910
SELECT idnum, name FROM people WHERE name LIKE 'b%'
1911
}]
1912
list $c $result
1913
}
1914
-result {{idnum name} {{4 barney} {5 betty} {6 bam-bam}}}
1915
}
1916
1917
test tdbc::postgres-10.16 {allrows - correct lexical scoping of variables} {*}{
1918
-setup {
1919
set stmt [::db prepare {
1920
SELECT idnum, name FROM people WHERE name LIKE :thePattern
1921
}]
1922
$stmt paramtype thePattern varchar 40
1923
}
1924
-body {
1925
set thePattern b%
1926
$stmt allrows
1927
}
1928
-cleanup {
1929
$stmt close
1930
}
1931
-result {{idnum 4 name barney} {idnum 5 name betty} {idnum 6 name bam-bam}}
1932
}
1933
1934
test tdbc::postgres-10.17 {allrows - parameters in a dictionary} {*}{
1935
-setup {
1936
set stmt [::db prepare {
1937
SELECT idnum, name FROM people WHERE name LIKE :thePattern
1938
}]
1939
$stmt paramtype thePattern varchar 40
1940
}
1941
-body {
1942
$stmt allrows {thePattern b%}
1943
}
1944
-cleanup {
1945
$stmt close
1946
}
1947
-result {{idnum 4 name barney} {idnum 5 name betty} {idnum 6 name bam-bam}}
1948
}
1949
1950
test tdbc::postgres-10.18 {allrows - parameters in a dictionary} {*}{
1951
-body {
1952
db allrows {
1953
SELECT idnum, name FROM people WHERE name LIKE :thePattern
1954
} {thePattern b%}
1955
}
1956
-result {{idnum 4 name barney} {idnum 5 name betty} {idnum 6 name bam-bam}}
1957
}
1958
1959
test tdbc::postgres-10.19 {allrows - variable not found} {*}{
1960
-setup {
1961
catch {unset thePattern}
1962
}
1963
-body {
1964
set thePattern(bogosity) {}
1965
db allrows {
1966
SELECT idnum, name FROM people WHERE name LIKE :thePattern
1967
}
1968
}
1969
-cleanup {
1970
unset thePattern
1971
}
1972
-result {}
1973
}
1974
1975
test tdbc::postgres-10.20 {allrows - too many args} {*}{
1976
-setup {
1977
set stmt [::db prepare {
1978
SELECT idnum, name FROM people
1979
}]
1980
}
1981
-body {
1982
$stmt allrows {} rubbish
1983
}
1984
-cleanup {
1985
$stmt close
1986
}
1987
-returnCodes error
1988
-result {wrong # args*}
1989
-match glob
1990
}
1991
1992
test tdbc::postgres-10.21 {bad -as} {*}{
1993
-body {
1994
db allrows -as trash {
1995
SELECT idnum, name FROM people
1996
}
1997
}
1998
-returnCodes error
1999
-result {bad variable type "trash": must be lists or dicts}
2000
}
2001
2002
test tdbc::postgres-11.1 {update - no rows} {*}{
2003
-setup {
2004
set stmt [::db prepare {
2005
UPDATE people SET info = 1 WHERE idnum > 6
2006
}]
2007
set rs [$stmt execute]
2008
}
2009
-body {
2010
$rs rowcount
2011
}
2012
-cleanup {
2013
rename $rs {}
2014
rename $stmt {}
2015
}
2016
-result 0
2017
}
2018
2019
test tdbc::postgres-11.2 {update - unique row} {*}{
2020
-setup {
2021
set stmt [::db prepare {
2022
UPDATE people SET info = 1 WHERE name = 'fred'
2023
}]
2024
}
2025
-body {
2026
set rs [$stmt execute]
2027
$rs rowcount
2028
}
2029
-cleanup {
2030
rename $rs {}
2031
rename $stmt {}
2032
}
2033
-result 1
2034
}
2035
2036
test tdbc::postgres-11.3 {update - multiple rows} {*}{
2037
-setup {
2038
set stmt [::db prepare {
2039
UPDATE people SET info = 1 WHERE name LIKE 'b%'
2040
}]
2041
}
2042
-body {
2043
set rs [$stmt execute]
2044
$rs rowcount
2045
}
2046
-cleanup {
2047
rename $rs {}
2048
rename $stmt {}
2049
}
2050
-result 3
2051
}
2052
2053
test tdbc::postgres-12.1 {delete - no rows} {*}{
2054
-setup {
2055
set stmt [::db prepare {
2056
DELETE FROM people WHERE name = 'nobody'
2057
}]
2058
}
2059
-body {
2060
set rs [$stmt execute]
2061
$rs rowcount
2062
}
2063
-cleanup {
2064
rename $rs {}
2065
rename $stmt {}
2066
}
2067
-result 0
2068
}
2069
2070
test tdbc::postgres-12.2 {delete - unique row} {*}{
2071
-setup {
2072
set stmt [::db prepare {
2073
DELETE FROM people WHERE name = 'fred'
2074
}]
2075
}
2076
-body {
2077
set rs [$stmt execute]
2078
$rs rowcount
2079
}
2080
-cleanup {
2081
rename $rs {}
2082
rename $stmt {}
2083
}
2084
-result 1
2085
}
2086
2087
test tdbc::postgres-12.3 {delete - multiple rows} {*}{
2088
-setup {
2089
set stmt [::db prepare {
2090
DELETE FROM people WHERE name LIKE 'b%'
2091
}]
2092
}
2093
-body {
2094
set rs [$stmt execute]
2095
$rs rowcount
2096
}
2097
-cleanup {
2098
rename $rs {}
2099
rename $stmt {}
2100
}
2101
-result 3
2102
}
2103
2104
test tdbc::postgres-13.1 {resultsets - no results} {*}{
2105
-setup {
2106
set stmt [::db prepare {
2107
SELECT name FROM people WHERE idnum = $idnum
2108
}]
2109
}
2110
-body {
2111
list \
2112
[llength [$stmt resultsets]] \
2113
[llength [::db resultsets]]
2114
}
2115
-cleanup {
2116
rename $stmt {}
2117
}
2118
-result {0 0}
2119
}
2120
2121
test tdbc::postgres-13.2 {resultsets - various statements and results} {*}{
2122
-setup {
2123
for {set i 0} {$i < 6} {incr i} {
2124
set stmts($i) [::db prepare {
2125
SELECT name FROM people WHERE idnum = :idnum
2126
}]
2127
$stmts($i) paramtype idnum integer
2128
for {set j 0} {$j < $i} {incr j} {
2129
set resultsets($i,$j) [$stmts($i) execute [list idnum $j]]
2130
}
2131
for {set j 1} {$j < $i} {incr j 2} {
2132
$resultsets($i,$j) close
2133
unset resultsets($i,$j)
2134
}
2135
}
2136
}
2137
-body {
2138
set x [list [llength [::db resultsets]]]
2139
for {set i 0} {$i < 6} {incr i} {
2140
lappend x [llength [$stmts($i) resultsets]]
2141
}
2142
set x
2143
}
2144
-cleanup {
2145
for {set i 0} {$i < 6} {incr i} {
2146
$stmts($i) close
2147
}
2148
}
2149
-result {9 0 1 1 2 2 3}
2150
}
2151
2152
#-------------------------------------------------------------------------------
2153
#
2154
# next tests require a fresh database connection. Close the existing one down
2155
2156
catch {
2157
set stmt [db prepare {
2158
DELETE FROM people
2159
}]
2160
$stmt execute
2161
}
2162
catch {
2163
rename ::db {}
2164
}
2165
2166
tdbc::postgres::connection create ::db {*}$::connFlags
2167
catch {
2168
set stmt [db prepare {
2169
INSERT INTO people(idnum, name, info) VALUES(:idnum, :name, NULL)
2170
}]
2171
$stmt paramtype idnum integer
2172
$stmt paramtype name varchar 40
2173
set idnum 1
2174
foreach name {fred wilma pebbles barney betty bam-bam} {
2175
set rs [$stmt execute]
2176
rename $rs {}
2177
incr idnum
2178
}
2179
rename $stmt {}
2180
}
2181
2182
test tdbc::postgres-14.1 {begin transaction - wrong # args} {*}{
2183
-body {
2184
::db begintransaction junk
2185
}
2186
-returnCodes error
2187
-match glob
2188
-result {wrong # args*}
2189
}
2190
2191
test tdbc::postgres-14.2 {commit - wrong # args} {*}{
2192
-body {
2193
::db commit junk
2194
}
2195
-returnCodes error
2196
-match glob
2197
-result {wrong # args*}
2198
}
2199
2200
test tdbc::postgres-14.3 {rollback - wrong # args} {*}{
2201
-body {
2202
::db rollback junk
2203
}
2204
-returnCodes error
2205
-match glob
2206
-result {wrong # args*}
2207
}
2208
2209
test tdbc::postgres-14.4 {commit - not in transaction} {*}{
2210
-body {
2211
list [catch {::db commit} result] $result $::errorCode
2212
}
2213
-match glob
2214
-result {1 {no transaction is in progress} {TDBC GENERAL_ERROR HY010 POSTGRES *}}
2215
}
2216
2217
test tdbc::postgres-14.5 {rollback - not in transaction} {*}{
2218
-body {
2219
list [catch {::db rollback} result] $result $::errorCode
2220
}
2221
-match glob
2222
-result {1 {no transaction is in progress} {TDBC GENERAL_ERROR HY010 POSTGRES *}}
2223
}
2224
2225
test tdbc::postgres-14.6 {empty transaction} {*}{
2226
-body {
2227
::db begintransaction
2228
::db commit
2229
}
2230
-result {}
2231
}
2232
2233
test tdbc::postgres-14.7 {empty rolled-back transaction} {*}{
2234
-body {
2235
::db begintransaction
2236
::db rollback
2237
}
2238
-result {}
2239
}
2240
2241
test tdbcpostgres-14.8 {rollback does not change database} {*}{
2242
-body {
2243
::db begintransaction
2244
set stmt [::db prepare {DELETE FROM people WHERE name = 'fred'}]
2245
set rs [$stmt execute]
2246
while {[$rs nextrow trash]} {}
2247
rename $rs {}
2248
rename $stmt {}
2249
::db rollback
2250
set stmt [::db prepare {SELECT idnum FROM people WHERE name = 'fred'}]
2251
set id {changes still visible after rollback}
2252
set rs [$stmt execute]
2253
while {[$rs nextrow -as lists row]} {
2254
set id [lindex $row 0]
2255
}
2256
rename $rs {}
2257
rename $stmt {}
2258
set id
2259
}
2260
-result 1
2261
}
2262
2263
test tdbc::postgres-14.9 {commit does change database} {*}{
2264
-setup {
2265
set stmt1 [db prepare {
2266
INSERT INTO people(idnum, name, info)
2267
VALUES(7, 'mr. gravel', 0)
2268
}]
2269
set stmt2 [db prepare {
2270
SELECT idnum FROM people WHERE name = 'mr. gravel'
2271
}]
2272
}
2273
-body {
2274
::db begintransaction
2275
set rs [$stmt1 execute]
2276
rename $rs {}
2277
::db commit
2278
set rs [$stmt2 execute]
2279
while {[$rs nextrow -as lists row]} {
2280
set id [lindex $row 0]
2281
}
2282
rename $rs {}
2283
set id
2284
}
2285
-cleanup {
2286
rename $stmt1 {}
2287
rename $stmt2 {}
2288
}
2289
-result 7
2290
}
2291
2292
2293
test tdbc::postgres-14.10 {nested transactions} {*}{
2294
-body {
2295
::db begintransaction
2296
list [catch {::db begintransaction} result] $result $::errorCode
2297
}
2298
-cleanup {
2299
catch {::db rollback}
2300
}
2301
-match glob
2302
-result {1 {Postgres does not support nested transactions} {TDBC GENERAL_ERROR HYC00 POSTGRES *}}
2303
}
2304
2305
#------------------------------------------------------------------------------
2306
#
2307
# Clean up database again for the next round.
2308
2309
catch {
2310
set stmt [db prepare {
2311
DELETE FROM people
2312
}]
2313
$stmt execute
2314
}
2315
catch {
2316
rename ::db {}
2317
}
2318
2319
tdbc::postgres::connection create ::db {*}$::connFlags
2320
catch {
2321
set stmt [db prepare {
2322
INSERT INTO people(idnum, name, info) VALUES(:idnum, :name, NULL)
2323
}]
2324
$stmt paramtype idnum integer
2325
$stmt paramtype name varchar 40
2326
set idnum 1
2327
foreach name {fred wilma pebbles barney betty bam-bam} {
2328
set rs [$stmt execute]
2329
rename $rs {}
2330
incr idnum
2331
}
2332
rename $stmt {}
2333
}
2334
2335
test tdbc::postgres-15.1 {successful (empty) transaction} {*}{
2336
-body {
2337
db transaction {
2338
concat ok
2339
}
2340
}
2341
-result ok
2342
}
2343
2344
test tdbc::postgres-15.2 {failing transaction does not get committed} {*}{
2345
-setup {
2346
set stmt1 [db prepare {
2347
DELETE FROM people WHERE name = 'fred'
2348
}]
2349
set stmt2 [db prepare {
2350
SELECT idnum FROM people WHERE name = 'fred'
2351
}]
2352
}
2353
-body {
2354
catch {
2355
::db transaction {
2356
set rs [$stmt1 execute]
2357
rename $rs {}
2358
error "abort the transaction"
2359
}
2360
} result
2361
set id {failed transaction got committed}
2362
set rs [$stmt2 execute]
2363
while {[$rs nextrow -as lists row]} {
2364
set id [lindex $row 0]
2365
}
2366
rename $rs {}
2367
list $result $id
2368
}
2369
-cleanup {
2370
rename $stmt1 {}
2371
rename $stmt2 {}
2372
}
2373
-result {{abort the transaction} 1}
2374
}
2375
2376
test tdbc::postgres-15.3 {successful transaction gets committed} {*}{
2377
-setup {
2378
set stmt1 [db prepare {
2379
INSERT INTO people(idnum, name, info)
2380
VALUES(7, 'mr. gravel', 0)
2381
}]
2382
set stmt2 [db prepare {
2383
SELECT idnum FROM people WHERE name = 'mr. gravel'
2384
}]
2385
}
2386
-body {
2387
::db transaction {
2388
set rs [$stmt1 execute]
2389
rename $rs {}
2390
}
2391
set rs [$stmt2 execute]
2392
while {[$rs nextrow -as lists row]} {
2393
set id [lindex $row 0]
2394
}
2395
rename $rs {}
2396
set id
2397
}
2398
-cleanup {
2399
rename $stmt1 {}
2400
rename $stmt2 {}
2401
}
2402
-result 7
2403
}
2404
2405
test tdbc::postgres-15.4 {break out of transaction commits it} {*}{
2406
-setup {
2407
set stmt1 [db prepare {
2408
INSERT INTO people(idnum, name, info)
2409
VALUES(8, 'gary granite', 0)
2410
}]
2411
set stmt2 [db prepare {
2412
SELECT idnum FROM people WHERE name = 'gary granite'
2413
}]
2414
}
2415
-body {
2416
while {1} {
2417
::db transaction {
2418
set rs [$stmt1 execute]
2419
rename $rs {}
2420
break
2421
}
2422
}
2423
set rs [$stmt2 execute]
2424
while {[$rs nextrow -as lists row]} {
2425
set id [lindex $row 0]
2426
}
2427
rename $rs {}
2428
set id
2429
}
2430
-cleanup {
2431
rename $stmt1 {}
2432
rename $stmt2 {}
2433
}
2434
-result 8
2435
}
2436
2437
test tdbc::postgres-15.5 {continue in transaction commits it} {*}{
2438
-setup {
2439
set stmt1 [db prepare {
2440
INSERT INTO people(idnum, name, info)
2441
VALUES(9, 'hud rockstone', 0)
2442
}]
2443
set stmt2 [db prepare {
2444
SELECT idnum FROM people WHERE name = 'hud rockstone'
2445
}]
2446
}
2447
-body {
2448
for {set i 0} {$i < 1} {incr i} {
2449
::db transaction {
2450
set rs [$stmt1 execute]
2451
rename $rs {}
2452
continue
2453
}
2454
}
2455
set rs [$stmt2 execute]
2456
while {[$rs nextrow -as lists row]} {
2457
set id [lindex $row 0]
2458
}
2459
rename $rs {}
2460
set id
2461
}
2462
-cleanup {
2463
rename $stmt1 {}
2464
rename $stmt2 {}
2465
}
2466
-result 9
2467
}
2468
2469
test tdbc::postgres-15.6 {return in transaction commits it} {*}{
2470
-setup {
2471
set stmt1 [db prepare {
2472
INSERT INTO people(idnum, name, info)
2473
VALUES(10, 'nelson stoneyfeller', 0)
2474
}]
2475
set stmt2 [db prepare {
2476
SELECT idnum FROM people WHERE name = 'nelson stoneyfeller'
2477
}]
2478
proc tdbcpostgres-15.6 {stmt1} {
2479
::db transaction {
2480
set rs [$stmt1 execute]
2481
rename $rs {}
2482
return
2483
}
2484
}
2485
}
2486
-body {
2487
tdbcpostgres-15.6 $stmt1
2488
set rs [$stmt2 execute]
2489
while {[$rs nextrow -as lists row]} {
2490
set id [lindex $row 0]
2491
}
2492
rename $rs {}
2493
set id
2494
}
2495
-cleanup {
2496
rename $stmt1 {}
2497
rename $stmt2 {}
2498
rename tdbcpostgres-15.6 {}
2499
}
2500
-result 10
2501
}
2502
2503
test tdbc::postgres-16.1 {database tables, wrong # args} {
2504
-body {
2505
set dict [::db tables % rubbish]
2506
}
2507
-returnCodes error
2508
-match glob
2509
-result {wrong # args*}
2510
}
2511
2512
test tdbc::postgres-16.2 {database tables - empty set} {
2513
-body {
2514
::db tables q%
2515
}
2516
-result {}
2517
}
2518
2519
test tdbc::postgres-16.3 {enumerate database tables} {*}{
2520
-body {
2521
set dict [::db tables]
2522
list [dict exists $dict people] [dict exists $dict property]
2523
}
2524
-result {1 0}
2525
}
2526
2527
test tdbc::postgres-16.4 {enumerate database tables} {*}{
2528
-body {
2529
set dict [::db tables p%]
2530
list [dict exists $dict people] [dict exists $dict property]
2531
}
2532
-result {1 0}
2533
}
2534
2535
2536
test tdbc::postgres-17.1 {database columns - wrong # args} {*}{
2537
-body {
2538
set dict [::db columns people % rubbish]
2539
}
2540
-returnCodes error
2541
-match glob
2542
-result {wrong # args*}
2543
}
2544
2545
test tdbc::postgres-17.2 {database columns - no such table} {*}{
2546
-body {
2547
::db columns rubbish
2548
}
2549
-returnCodes error
2550
-match glob
2551
-result {relation * does not exist}
2552
}
2553
2554
2555
2556
test tdbc::postgres-17.3 {database columns - no match pattern} {*}{
2557
-body {
2558
set result {}
2559
dict for {colname attrs} [::db columns people] {
2560
lappend result $colname \
2561
[dict get $attrs type] \
2562
[expr {[dict exists $attrs precision] ?
2563
[dict get $attrs precision] : {NULL}}] \
2564
[expr {[dict exists $attrs scale] ?
2565
[dict get $attrs scale] : {NULL}}] \
2566
[dict get $attrs nullable]
2567
}
2568
lsort -stride 5 $result
2569
}
2570
-match glob
2571
-result {idnum integer * 0 0 info integer * 0 1 name varchar 40 *}
2572
}
2573
2574
# TODO: precision not a number of bytes?!
2575
# -result {idnum integer 11 0 0 info integer 11 0 1}
2576
2577
test tdbc::postgres-17.4 {database columns - match pattern} {*}{
2578
-constraints !sqlite
2579
-body {
2580
set result {}
2581
dict for {colname attrs} [::db columns people i%] {
2582
lappend result $colname \
2583
[dict get $attrs type] \
2584
[expr {[dict exists $attrs precision] ?
2585
[dict get $attrs precision] : {NULL}}] \
2586
[expr {[dict exists $attrs scale] ?
2587
[dict get $attrs scale] : {NULL}}] \
2588
[dict get $attrs nullable]
2589
}
2590
lsort -stride 5 $result
2591
}
2592
-result {idnum integer 32 0 0 info integer 32 0 1}
2593
}
2594
2595
test tdbc::postgres-18.1 {$statement params - excess arg} {*}{
2596
-setup {
2597
set s [::db prepare {
2598
SELECT name FROM people
2599
WHERE name LIKE :pattern
2600
AND idnum >= :minid
2601
}]
2602
$s paramtype minid numeric 10 0
2603
$s paramtype pattern varchar 40
2604
}
2605
-body {
2606
$s params excess
2607
}
2608
-cleanup {
2609
rename $s {}
2610
}
2611
-returnCodes error
2612
-match glob
2613
-result {wrong # args*}
2614
}
2615
2616
test tdbc::postgres-18.2 {$statement params - no params} {*}{
2617
-setup {
2618
set s [::db prepare {
2619
SELECT name FROM people
2620
}]
2621
}
2622
-body {
2623
$s params
2624
}
2625
-cleanup {
2626
rename $s {}
2627
}
2628
-result {}
2629
}
2630
2631
test tdbc::postgres-18.3 {$statement params - try a few data types} {*}{
2632
-setup {
2633
set s [::db prepare {
2634
SELECT name FROM people
2635
WHERE name LIKE :pattern
2636
AND idnum >= :minid
2637
}]
2638
$s paramtype minid decimal 10 0
2639
$s paramtype pattern varchar 40
2640
}
2641
-body {
2642
set d [$s params]
2643
list \
2644
[dict get $d minid direction] \
2645
[dict get $d minid type] \
2646
[dict get $d minid precision] \
2647
[dict get $d minid scale] \
2648
[dict get $d pattern direction] \
2649
[dict get $d pattern type] \
2650
[dict get $d pattern precision]
2651
}
2652
-cleanup {
2653
rename $s {}
2654
}
2655
-result {in decimal 10 0 in varchar 40}
2656
}
2657
2658
test tdbc::postgres-18.4 {$statement params - default param types} {
2659
-setup {
2660
set s [::db prepare {
2661
SELECT name FROM people
2662
WHERE name LIKE :pattern
2663
AND idnum >= :minid
2664
}]
2665
}
2666
-body {
2667
set d [$s params]
2668
list \
2669
[dict get $d minid direction] \
2670
[dict get $d minid type] \
2671
[dict get $d minid precision] \
2672
[dict get $d minid scale] \
2673
[dict get $d pattern direction] \
2674
[dict get $d pattern type] \
2675
[dict get $d pattern precision] \
2676
[dict get $d pattern scale]
2677
}
2678
-cleanup {
2679
rename $s {}
2680
}
2681
-result {in integer 0 0 in text 0 0}
2682
}
2683
2684
test tdbc::postgres-18.5 {statement with parameter of indeterminate type} {
2685
-setup {
2686
set s [::db prepare {SELECT :foo::VARCHAR}]
2687
}
2688
-body {
2689
set d [$s params]
2690
list \
2691
[dict get $d foo direction] \
2692
[dict get $d foo type] \
2693
[dict get $d foo precision] \
2694
[dict get $d foo scale]
2695
}
2696
-cleanup {
2697
rename $s {}
2698
}
2699
-result {in varchar 0 0}
2700
}
2701
2702
test tdbc::postgres-19.1 {$connection configure - no args} \
2703
-setup {
2704
::db configure -encoding UTF8
2705
} \
2706
-body {
2707
::db configure
2708
} \
2709
-match glob \
2710
-result [list \
2711
-host * -hostaddr * -port * \
2712
-database * -user * -password * \
2713
-options {} -tty {} -service {} -timeout {} \
2714
-sslmode * -requiressl * -krbsrvname * \
2715
-encoding UTF8 -isolation readcommitted \
2716
-readonly 0 ]
2717
2718
test tdbc::postgres-19.2 {$connection configure - unknown arg} {*}{
2719
-body {
2720
::db configure -junk
2721
}
2722
-returnCodes error
2723
-match glob
2724
-result "bad option *"
2725
}
2726
2727
test tdbc::postgres-19.3 {$connection configure - unknown arg} {*}{
2728
-body {
2729
list [catch {::db configure -rubbish} result] $result $::errorCode
2730
}
2731
-match glob
2732
-result {1 {bad option "-rubbish": must be *} {TCL LOOKUP INDEX option -rubbish}}
2733
}
2734
2735
test tdbc::postgres-19.4 {$connection configure - set unknown arg} {*}{
2736
-body {
2737
list [catch {::db configure -rubbish rubbish} result] \
2738
$result $::errorCode
2739
}
2740
-match glob
2741
-result {1 {bad option "-rubbish": must be *} {TCL LOOKUP INDEX option -rubbish}}
2742
}
2743
2744
test tdbc::postgres-19.5 {$connection configure - set inappropriate arg} {*}{
2745
-body {
2746
list [catch {::db configure -host rubbish} result] \
2747
$result $::errorCode
2748
}
2749
-result {1 {"-host" option cannot be changed dynamically} {TDBC GENERAL_ERROR HY000 POSTGRES -1}}
2750
}
2751
2752
test tdbc::postgres-19.6 {$connection configure - wrong # args} {*}{
2753
-body {
2754
::db configure -parent . -junk
2755
}
2756
-returnCodes error
2757
-match glob
2758
-result "wrong # args*"
2759
}
2760
2761
test tdbc::postgres-19.9 {$connection configure - -encoding} {*}{
2762
-setup {
2763
::db configure -encoding UTF8
2764
}
2765
-body {
2766
::db configure -encoding
2767
}
2768
-result UTF8
2769
}
2770
2771
2772
test tdbc::postgres-19.10 {$connection configure - -isolation} {*}{
2773
-body {
2774
::db configure -isolation junk
2775
}
2776
-returnCodes error
2777
-match glob
2778
-result {bad isolation level "junk"*}
2779
}
2780
2781
test tdbc::postgres-19.11 {$connection configure - -isolation} {*}{
2782
-body {
2783
list [::db configure -isolation readuncommitted] \
2784
[::db configure -isolation] \
2785
[::db configure -isolation readcommitted] \
2786
[::db configure -isolation] \
2787
[::db configure -isolation serializable] \
2788
[::db configure -isolation] \
2789
[::db configure -isolation repeatableread] \
2790
[::db configure -isolation]
2791
}
2792
-result {{} readuncommitted {} readcommitted {} serializable {} repeatableread}
2793
}
2794
2795
test tdbc::postgres-19.12 {$connection configure - -readonly set inappropriate arg } {*}{
2796
-body {
2797
::db configure -readonly junk
2798
}
2799
-returnCodes error
2800
-result {expected boolean value but got "junk"}
2801
}
2802
2803
test tdbc::postgres-19.13 {$connection configure - -readonly} {*}{
2804
-body {
2805
list [::db configure -readonly] \
2806
[::db configure -readonly 1] \
2807
[::db configure -readonly] \
2808
[::db configure -readonly 0] \
2809
[::db configure -readonly]
2810
}
2811
-result {0 {} 1 {} 0}
2812
}
2813
2814
test tdbc::postgres-19.14 {$connection configure - -timeout} {*}{
2815
-body {
2816
::db configure -timeout junk
2817
}
2818
-returnCodes error
2819
-result {"-timeout" option cannot be changed dynamically}
2820
}
2821
2822
2823
test tdbc::postgres-19.15 {$connection configure - -db} {*}{
2824
-body {
2825
::db configure -db information_schema
2826
}
2827
-returnCodes error
2828
-result {"-db" option cannot be changed dynamically}
2829
}
2830
2831
test tdbc::postgres-19.16 {$connection configure - -user} \
2832
-body {
2833
::db configure -user nobody
2834
} \
2835
-returnCodes error \
2836
-result {"-user" option cannot be changed dynamically} \
2837
2838
2839
test tdbc::postgres-22.1 {duplicate column name} {*}{
2840
-body {
2841
set stmt [::db prepare {
2842
SELECT a.idnum, b.idnum
2843
FROM people a, people b
2844
WHERE a.name = 'hud rockstone'
2845
AND b.info = a.info
2846
}]
2847
set rs [$stmt execute]
2848
$rs columns
2849
}
2850
-result {idnum idnum#2}
2851
-cleanup {
2852
$rs close
2853
$stmt close
2854
}
2855
}
2856
2857
test tdbc::postgres-20.1 {bit values} {*}{
2858
-setup {
2859
catch {db allrows {DROP TABLE bittest}}
2860
db allrows {
2861
CREATE TABLE bittest (
2862
bitstring BIT(14)
2863
)
2864
}
2865
db allrows {INSERT INTO bittest(bitstring) VALUES(b'11010001010110')}
2866
}
2867
-body {
2868
db allrows {SELECT bitstring FROM bittest}
2869
}
2870
-result {{bitstring 11010001010110}}
2871
-cleanup {
2872
db allrows {DROP TABLE bittest}
2873
}
2874
}
2875
2876
test tdbc::postgres-20.2 {direct value transfers} {*}{
2877
-setup {
2878
set bigtext [string repeat a 200]
2879
set bigbinary {}
2880
for {set i 1} {$i < 256} {incr i} {
2881
append bigbinary [format %c $i]
2882
}
2883
catch {db allrows {DROP TABLE typetest}}
2884
db allrows {
2885
CREATE TABLE typetest (
2886
xsmall1 SMALLINT,
2887
xint1 INTEGER,
2888
xfloat1 FLOAT,
2889
xdouble1 DOUBLE PRECISION,
2890
xtimestamp1 TIMESTAMP,
2891
xbig1 BIGINT,
2892
xdate1 DATE,
2893
xtime1 TIME,
2894
xbit1 BIT(14),
2895
xdec1 DECIMAL(10),
2896
xtext1 TEXT,
2897
xvarb1 BYTEA,
2898
xvarc1 VARCHAR(256),
2899
xchar1 CHAR(20)
2900
)
2901
}
2902
set stmt [db prepare {
2903
INSERT INTO typetest(
2904
xsmall1, xint1, xfloat1,
2905
xdouble1, xtimestamp1, xbig1,
2906
xdate1, xtime1, xbit1,
2907
xdec1, xtext1, xvarb1,
2908
xvarc1, xchar1
2909
) values (
2910
:xsmall1, :xint1, :xfloat1,
2911
:xdouble1, :xtimestamp1, :xbig1,
2912
:xdate1, :xtime1, :xbit1,
2913
:xdec1, :xtext1, :xvarb1,
2914
:xvarc1, :xchar1
2915
)
2916
}]
2917
$stmt paramtype xsmall1 smallint
2918
$stmt paramtype xint1 integer
2919
$stmt paramtype xfloat1 float
2920
$stmt paramtype xdouble1 double
2921
$stmt paramtype xtimestamp1 timestamp
2922
$stmt paramtype xbig1 bigint
2923
$stmt paramtype xdate1 date
2924
$stmt paramtype xtime1 time
2925
$stmt paramtype xbit1 bit 14
2926
$stmt paramtype xdec1 decimal 10 0
2927
$stmt paramtype xtext1 text
2928
$stmt paramtype xvarb1 varbinary
2929
$stmt paramtype xvarc1 varchar
2930
$stmt paramtype xchar1 char 20
2931
}
2932
-body {
2933
set trouble {}
2934
set xsmall1 0x3039
2935
set xint1 0xbc614e
2936
set xfloat1 1.125
2937
set xdouble1 1.125
2938
set xtimestamp1 {2001-02-03 04:05:06}
2939
set xbig1 0xbc614e
2940
set xdate1 2001-02-03
2941
set xtime1 04:05:06
2942
set xbit1 01101000101011
2943
set xdec1 0xbc614e
2944
set xtext1 $bigtext
2945
set xvarb1 $bigbinary
2946
set xvarc1 $bigtext
2947
set xchar1 [string repeat a 20]
2948
$stmt allrows
2949
db foreach row {select * from typetest} {
2950
foreach v {
2951
xsmall1 xint1 xfloat1
2952
xdouble1 xtimestamp1 xbig1
2953
xdate1 xtime1 xbit1
2954
xdec1 xtext1 xvarb1
2955
xvarc1 xchar1
2956
} {
2957
if {![dict exists $row $v]} {
2958
append trouble $v " did not appear in result set\n"
2959
} elseif {[set $v] != [dict get $row $v]} {
2960
append trouble [list $v is [dict get $row $v] \
2961
should be [set $v]] \n
2962
}
2963
}
2964
}
2965
set trouble
2966
}
2967
-result {}
2968
-cleanup {
2969
$stmt close
2970
db allrows {
2971
DROP TABLE typetest
2972
}
2973
}
2974
}
2975
2976
# Information schema tests require additional tables in the database.
2977
# Create them now.
2978
2979
catch {::db allrows {DROP TABLE d}}
2980
catch {::db allrows {DROP TABLE c}}
2981
catch {::db allrows {DROP TABLE b}}
2982
catch {::db allrows {DROP TABLE a}}
2983
2984
# The MyISAM engine doesn't track foreign key constraints, so force the
2985
# tables to be InnoDB.
2986
2987
::db allrows {
2988
CREATE TABLE a (
2989
k1 INTEGER,
2990
CONSTRAINT pk_a PRIMARY KEY(k1)
2991
)
2992
}
2993
2994
::db allrows {
2995
CREATE TABLE b (
2996
k1 INTEGER,
2997
k2 INTEGER,
2998
CONSTRAINT pk_b PRIMARY KEY(k1, k2),
2999
CONSTRAINT fk_b1 FOREIGN KEY (k1) REFERENCES a(k1),
3000
CONSTRAINT fk_b2 FOREIGN KEY (k2) REFERENCES a(k1)
3001
)
3002
}
3003
3004
::db allrows {
3005
CREATE TABLE c (
3006
p1 INTEGER,
3007
p2 INTEGER,
3008
CONSTRAINT pk_c PRIMARY KEY(p1, p2),
3009
CONSTRAINT fk_c1 FOREIGN KEY (p1) REFERENCES a(k1),
3010
CONSTRAINT fk_c2 FOREIGN KEY (p2) REFERENCES a(k1),
3011
CONSTRAINT fk_cpair FOREIGN KEY (p2,p1) REFERENCES b(k1,k2)
3012
)
3013
}
3014
3015
::db allrows {
3016
CREATE TABLE d (
3017
dtext VARCHAR(40)
3018
)
3019
}
3020
3021
test tdbc::postgres-23.1 {Primary keys - no arg} {*}{
3022
-body {
3023
::db primarykeys
3024
}
3025
-returnCodes error
3026
-match glob
3027
-result {wrong # args*}
3028
}
3029
test tdbc::postgres-23.2 {Primary keys - no primary key} {*}{
3030
-body {
3031
::db primarykeys d
3032
}
3033
-result {}
3034
}
3035
test tdbc::postgres-23.3 {Primary keys - simple primary key} {*}{
3036
-body {
3037
set result {}
3038
foreach row [::db primarykeys a] {
3039
lappend result [dict get $row columnName] [dict get $row ordinalPosition]
3040
}
3041
set result
3042
}
3043
-result {k1 1}
3044
}
3045
test tdbc::postgres-23.4 {Primary keys - compound primary key} {*}{
3046
-body {
3047
set result {}
3048
foreach row [::db primarykeys b] {
3049
lappend result [dict get $row columnName] [dict get $row ordinalPosition]
3050
}
3051
set result
3052
}
3053
-result {k1 1 k2 2}
3054
}
3055
3056
test tdbc::postgres-24.1 {Foreign keys - wrong # args} {*}{
3057
-body {
3058
::db foreignkeys -wrong
3059
}
3060
-returnCodes error
3061
-match glob
3062
-result {wrong # args*}
3063
}
3064
3065
test tdbc::postgres-24.2 {Foreign keys - bad arg} {*}{
3066
-body {
3067
::db foreignkeys -primary a -rubbish b
3068
}
3069
-returnCodes error
3070
-match glob
3071
-result {bad option "-rubbish"*}
3072
}
3073
3074
test tdbc::postgres-24.3 {Foreign keys - redundant arg} {*}{
3075
-body {
3076
::db foreignkeys -primary a -primary b
3077
}
3078
-returnCodes error
3079
-match glob
3080
-result {duplicate option "primary"*}
3081
}
3082
3083
test tdbc::postgres-24.4 {Foreign keys - list all} \
3084
-body {
3085
set result {}
3086
set wanted {fk_b1 {} fk_b2 {} fk_c1 {} fk_c2 {} fk_cpair {}}
3087
foreach row [::db foreignkeys] {
3088
if {[dict exists $wanted [dict get $row foreignConstraintName]]} {
3089
dict set result [dict get $row foreignConstraintName] \
3090
[dict get $row ordinalPosition] \
3091
[list [dict get $row foreignTable] \
3092
[dict get $row foreignColumn] \
3093
[dict get $row primaryTable] \
3094
[dict get $row primaryColumn]]
3095
}
3096
}
3097
lsort -index 0 -stride 2 $result
3098
} \
3099
-result [list \
3100
fk_b1 {1 {b k1 a k1}} \
3101
fk_b2 {1 {b k2 a k1}} \
3102
fk_c1 {1 {c p1 a k1}} \
3103
fk_c2 {1 {c p2 a k1}} \
3104
fk_cpair {1 {c p2 b k1} 2 {c p1 b k2}}]
3105
3106
test tdbc::postgres-24.5 {Foreign keys - -foreign} \
3107
-body {
3108
set result {}
3109
set wanted {fk_b1 {} fk_b2 {} fk_c1 {} fk_c2 {} fk_cpair {}}
3110
foreach row [::db foreignkeys -foreign c] {
3111
if {[dict exists $wanted [dict get $row foreignConstraintName]]} {
3112
dict set result [dict get $row foreignConstraintName] \
3113
[dict get $row ordinalPosition] \
3114
[list [dict get $row foreignTable] \
3115
[dict get $row foreignColumn] \
3116
[dict get $row primaryTable] \
3117
[dict get $row primaryColumn]]
3118
}
3119
}
3120
lsort -index 0 -stride 2 $result
3121
} \
3122
-result [list \
3123
fk_c1 {1 {c p1 a k1}} \
3124
fk_c2 {1 {c p2 a k1}} \
3125
fk_cpair {1 {c p2 b k1} 2 {c p1 b k2}}]
3126
3127
test tdbc::postgres-24.6 {Foreign keys - -primary} \
3128
-body {
3129
set result {}
3130
set wanted {fk_b1 {} fk_b2 {} fk_c1 {} fk_c2 {} fk_cpair {}}
3131
foreach row [::db foreignkeys -primary a] {
3132
if {[dict exists $wanted [dict get $row foreignConstraintName]]} {
3133
dict set result [dict get $row foreignConstraintName] \
3134
[dict get $row ordinalPosition] \
3135
[list [dict get $row foreignTable] \
3136
[dict get $row foreignColumn] \
3137
[dict get $row primaryTable] \
3138
[dict get $row primaryColumn]]
3139
}
3140
}
3141
lsort -index 0 -stride 2 $result
3142
} \
3143
-result [list \
3144
fk_b1 {1 {b k1 a k1}} \
3145
fk_b2 {1 {b k2 a k1}} \
3146
fk_c1 {1 {c p1 a k1}} \
3147
fk_c2 {1 {c p2 a k1}}]
3148
3149
test tdbc::postgres-24.7 {Foreign keys - -foreign and -primary} \
3150
-body {
3151
set result {}
3152
set wanted {fk_b1 {} fk_b2 {} fk_c1 {} fk_c2 {} fk_cpair {}}
3153
foreach row [::db foreignkeys -foreign c -primary b] {
3154
if {[dict exists $wanted [dict get $row foreignConstraintName]]} {
3155
dict set result [dict get $row foreignConstraintName] \
3156
[dict get $row ordinalPosition] \
3157
[list [dict get $row foreignTable] \
3158
[dict get $row foreignColumn] \
3159
[dict get $row primaryTable] \
3160
[dict get $row primaryColumn]]
3161
}
3162
}
3163
lsort -index 0 -stride 2 $result
3164
} \
3165
-result [list fk_cpair {1 {c p2 b k1} 2 {c p1 b k2}}]
3166
3167
test tdbc::postgres-30.0 {Multiple result sets} {*}{
3168
-setup {
3169
set stmt [::db prepare { }]
3170
}
3171
-body {
3172
set resultset [$stmt execute {}]
3173
}
3174
-cleanup {
3175
$stmt close
3176
}
3177
-returnCodes error
3178
-result {empty query}
3179
}
3180
3181
test tdbc::postgres-30.1 {Multiple result sets - but in reality only one} {*}{
3182
-setup {
3183
::db allrows {delete from people}
3184
set stmt [db prepare {
3185
INSERT INTO people(idnum, name, info) VALUES(:idnum, :name, NULL)
3186
}]
3187
$stmt paramtype idnum integer
3188
$stmt paramtype name varchar 40
3189
set idnum 1
3190
foreach name {fred wilma pebbles barney betty bam-bam} {
3191
set rs [$stmt execute]
3192
rename $rs {}
3193
incr idnum
3194
}
3195
rename $stmt {}
3196
}
3197
-body {
3198
set stmt [::db prepare {
3199
select idnum, name from people where name = :a
3200
}]
3201
catch {
3202
set resultset [$stmt execute {a wilma}]
3203
catch {
3204
set rowsets {}
3205
while {1} {
3206
set rows {}
3207
while {[$resultset nextrow row]} {
3208
lappend rows $row
3209
}
3210
lappend rowsets $rows
3211
if {[$resultset nextresults] == 0} break
3212
}
3213
set rowsets
3214
} results
3215
rename $resultset {}
3216
set results
3217
} results
3218
rename $stmt {}
3219
set results
3220
}
3221
-result {{{idnum 2 name wilma}}}
3222
}
3223
3224
#-------------------------------------------------------------------------------
3225
3226
# Test cleanup. Drop tables and get rid of the test database.
3227
3228
3229
catch {::db allrows {DROP TABLE d}}
3230
catch {::db allrows {DROP TABLE c}}
3231
catch {::db allrows {DROP TABLE b}}
3232
catch {::db allrows {DROP TABLE a}}
3233
catch {::db allrows {DROP TABLE people}}
3234
3235
catch {rename ::db {}}
3236
3237
cleanupTests
3238
return
3239
3240
# Local Variables:
3241
# mode: tcl
3242
# End:
Loggerhead is a web-based interface for Breezy
Version: 2.0.1