1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
|
#!/usr/local/bin/perl
#
#
# This is testing the transaction support.
#
# 2011-01-23 stefan(s.bv.)
# New version based on t/testlib.pl and Firebird.dbtest
use strict;
use warnings;
use Test::More;
use DBI;
use lib 't','.';
use TestFirebird;
my $T = TestFirebird->new;
my ( $dbh, $error_str ) =
$T->connect_to_database( { ChopBlanks => 1, AutoCommit => 1 } );
if ($error_str) {
BAIL_OUT("Unknown: $error_str!");
}
else {
plan tests => 30;
}
unless ( $dbh->isa('DBI::db') ) {
plan skip_all => 'Connection to database failed, cannot continue testing';
}
ok($dbh, 'Connected to the database');
# DBI->trace(4, "trace.txt");
# ------- TESTS ------------------------------------------------------------- #
#
# Find a possible new table name
#
my $table = find_new_table($dbh);
ok($table, "TABLE is '$table'");
use vars qw($gotWarning);
sub CatchWarning ($) {
$gotWarning = 1;
}
#
# Create a new table
#
my $def =<<"DEF";
CREATE TABLE $table (
id INTEGER PRIMARY KEY,
name CHAR(64)
)
DEF
ok( $dbh->do($def), qq{CREATE TABLE '$table'} );
ok($dbh->{AutoCommit}, 'AutoCommit is on');
#- Turn AutoCommit off
$dbh->{AutoCommit} = 0;
ok(! $dbh->{AutoCommit}, 'AutoCommit is off');
#-- Check rollback
ok($dbh->do("INSERT INTO $table VALUES (1, 'Jochen')"), 'INSERT 1');
is(NumRows($dbh, $table), 1, 'CHECK rows');
ok($dbh->rollback, 'ROLLBACK');
is(NumRows($dbh, $table), 0, 'CHECK rows');
#-- Check commit
ok($dbh->do("DELETE FROM $table WHERE id = 1"), 'DELETE id=1');
is(NumRows($dbh, $table), 0, 'CHECK rows');
ok($dbh->commit, 'COMMIT');
is(NumRows($dbh, $table), 0, 'CHECK rows');
#-- Check auto rollback after disconnect
ok($dbh->do("INSERT INTO $table VALUES (1, 'Jochen')"), 'INSERT 1');
is(NumRows($dbh, $table), 1, 'CHECK rows');
ok($dbh->disconnect, 'DISCONNECT for auto rollback');
#--- Reconnect
( $dbh, $error_str ) = $T->connect_to_database( { ChopBlanks => 1 } );
ok($dbh, 'reConnected to the database');
is(NumRows($dbh, $table), 0, 'CHECK rows');
#--- Check whether AutoCommit is on again
ok($dbh->{AutoCommit}, 'AutoCommit is on');
#-- Check whether AutoCommit mode works.
ok($dbh->do("INSERT INTO $table VALUES (1, 'Jochen')"), 'INSERT 1');
is(NumRows($dbh, $table), 1, 'CHECK rows');
ok($dbh->disconnect, 'DISCONNECT for auto commit');
#--- Reconnect
( $dbh, $error_str ) = $T->connect_to_database( { ChopBlanks => 1 } );
ok($dbh, 'reConnected to the database');
is(NumRows($dbh, $table), 1, 'CHECK rows');
#-- Check whether commit issues a warning in AutoCommit mode
ok($dbh->do("INSERT INTO $table VALUES (2, 'Tim')"), 'INSERT 2');
my $result;
$@ = '';
$SIG{__WARN__} = \&CatchWarning;
$gotWarning = 0;
eval { $result = $dbh->commit; };
$SIG{__WARN__} = 'DEFAULT';
ok($gotWarning, 'GOT WARNING');
# Check whether rollback issues a warning in AutoCommit mode
# We accept error messages as being legal, because the DBI
# requirement of just issueing a warning seems scary.
ok($dbh->do("INSERT INTO $table VALUES (3, 'Alligator')"), 'INSERT 3');
$@ = '';
$SIG{__WARN__} = \&CatchWarning;
$gotWarning = 0;
eval { $result = $dbh->rollback; };
$SIG{__WARN__} = 'DEFAULT';
ok($gotWarning, 'GOT WARNING');
#
# Drop the test table
#
$dbh->{AutoCommit} = 1;
ok( $dbh->do("DROP TABLE $table"), "DROP TABLE '$table'" );
#
# Finally disconnect.
#
ok($dbh->disconnect, 'DISCONNECT');
sub NumRows {
my($dbh, $table) = @_;
my $sth = $dbh->prepare( qq{SELECT * FROM $table} );
$sth->execute;
my $got = 0;
while ($sth->fetchrow_arrayref) {
$got++;
}
return $got;
}
|
