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
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
|
#!/usr/local/bin/perl
#
# $Id: 50commit.t,v 1.1.1.1 2004/08/08 15:03:59 matt Exp $
#
# This is testing the transaction support.
#
$^W = 1;
#
# Include lib.pl
#
require DBI;
$mdriver = "";
foreach $file ("lib.pl", "t/lib.pl") {
do "./$file"; if ($@) { print STDERR "Error while executing lib.pl: $@\n";
exit 10;
}
if ($mdriver ne '') {
last;
}
}
if ($mdriver eq 'whatever') {
print "1..0\n";
exit 0;
}
use vars qw($gotWarning);
sub CatchWarning ($) {
$gotWarning = 1;
}
sub NumRows($$$) {
my($dbh, $table, $num) = @_;
my($sth, $got);
if (!($sth = $dbh->prepare("SELECT * FROM $table"))) {
return "Failed to prepare: err " . $dbh->err . ", errstr "
. $dbh->errstr;
}
if (!$sth->execute) {
return "Failed to execute: err " . $dbh->err . ", errstr "
. $dbh->errstr;
}
$got = 0;
while ($sth->fetchrow_arrayref) {
++$got;
}
if ($got ne $num) {
return "Wrong result: Expected $num rows, got $got.\n";
}
return '';
}
#
# Main loop; leave this untouched, put tests after creating
# the new table.
#
while (Testing()) {
#
# Connect to the database
Test($state or ($dbh = DBI->connect($test_dsn, $test_user,
$test_password)),
'connect',
"Attempting to connect.\n")
or ErrMsgF("Cannot connect: Error %s.\n\n"
. "Make sure, your database server is up and running.\n"
. "Check that '$test_dsn' references a valid database"
. " name.\nDBI error message: %s\n",
$DBI::err, $DBI::errstr);
#
# Find a possible new table name
#
Test($state or $table = FindNewTable($dbh))
or ErrMsgF("Cannot determine a legal table name: Error %s.\n",
$dbh->errstr);
#
# Create a new table
#
Test($state or ($def = TableDefinition($table,
["id", "INTEGER", 4, 0],
["name", "CHAR", 64, 0]),
$dbh->do($def)))
or ErrMsgF("Cannot create table: Error %s.\n",
$dbh->errstr);
Test($state or $dbh->{AutoCommit})
or ErrMsg("AutoCommit is off\n", 'AutoCommint on');
#
# Tests for databases that do support transactions
#
if (HaveTransactions()) {
# Turn AutoCommit off
$dbh->{AutoCommit} = 0;
Test($state or (!$dbh->err && !$dbh->errstr && !$dbh->{AutoCommit}))
or ErrMsgF("Failed to turn AutoCommit off: err %s, errstr %s\n",
$dbh->err, $dbh->errstr);
# Check rollback
Test($state or $dbh->do("INSERT INTO $table VALUES (1, 'Jochen')"))
or ErrMsgF("Failed to insert value: err %s, errstr %s.\n",
$dbh->err, $dbh->errstr);
my $msg;
Test($state or !($msg = NumRows($dbh, $table, 1)))
or ErrMsg($msg);
Test($state or $dbh->rollback)
or ErrMsgF("Failed to rollback: err %s, errstr %s.\n",
$dbh->err, $dbh->errstr);
Test($state or !($msg = NumRows($dbh, $table, 0)))
or ErrMsg($msg);
# Check commit
Test($state or $dbh->do("DELETE FROM $table WHERE id = 1"))
or ErrMsgF("Failed to insert value: err %s, errstr %s.\n",
$dbh->err, $dbh->errstr);
Test($state or !($msg = NumRows($dbh, $table, 0)))
or ErrMsg($msg);
Test($state or $dbh->commit)
or ErrMsgF("Failed to rollback: err %s, errstr %s.\n",
$dbh->err, $dbh->errstr);
Test($state or !($msg = NumRows($dbh, $table, 0)))
or ErrMsg($msg);
# Check auto rollback after disconnect
Test($state or $dbh->do("INSERT INTO $table VALUES (1, 'Jochen')"))
or ErrMsgF("Failed to insert: err %s, errstr %s.\n",
$dbh->err, $dbh->errstr);
Test($state or !($msg = NumRows($dbh, $table, 1)))
or ErrMsg($msg);
Test($state or $dbh->disconnect)
or ErrMsgF("Failed to disconnect: err %s, errstr %s.\n",
$dbh->err, $dbh->errstr);
Test($state or ($dbh = DBI->connect($test_dsn, $test_user,
$test_password)))
or ErrMsgF("Failed to reconnect: err %s, errstr %s.\n",
$DBI::err, $DBI::errstr);
Test($state or !($msg = NumRows($dbh, $table, 0)))
or ErrMsg($msg);
# Check whether AutoCommit is on again
Test($state or $dbh->{AutoCommit})
or ErrMsg("AutoCommit is off\n");
#
# Tests for databases that don't support transactions
#
} else {
if (!$state) {
$@ = '';
eval { $dbh->{AutoCommit} = 0; }
}
Test($state or $@)
or ErrMsg("Expected fatal error for AutoCommit => 0\n",
'AutoCommit off -> error');
}
# Check whether AutoCommit mode works.
Test($state or $dbh->do("INSERT INTO $table VALUES (1, 'Jochen')"))
or ErrMsgF("Failed to delete: err %s, errstr %s.\n",
$dbh->err, $dbh->errstr);
Test($state or !($msg = NumRows($dbh, $table, 1)), 'NumRows')
or ErrMsg($msg);
Test($state or $dbh->disconnect, 'disconnect')
or ErrMsgF("Failed to disconnect: err %s, errstr %s.\n",
$dbh->err, $dbh->errstr);
Test($state or ($dbh = DBI->connect($test_dsn, $test_user,
$test_password)))
or ErrMsgF("Failed to reconnect: err %s, errstr %s.\n",
$DBI::err, $DBI::errstr);
Test($state or !($msg = NumRows($dbh, $table, 1)))
or ErrMsg($msg);
# Check whether commit issues a warning in AutoCommit mode
Test($state or $dbh->do("INSERT INTO $table VALUES (2, 'Tim')"))
or ErrMsgF("Failed to insert: err %s, errstr %s.\n",
$dbh->err, $dbh->errstr);
my $result;
if (!$state) {
$@ = '';
$SIG{__WARN__} = \&CatchWarning;
$gotWarning = 0;
eval { $result = $dbh->commit; };
$SIG{__WARN__} = 'DEFAULT';
}
Test($state or $gotWarning)
or ErrMsg("Missing warning when committing in AutoCommit mode");
# 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.
Test($state or $dbh->do("INSERT INTO $table VALUES (3, 'Alligator')"))
or ErrMsgF("Failed to insert: err %s, errstr %s.\n",
$dbh->err, $dbh->errstr);
if (!$state) {
$@ = '';
$SIG{__WARN__} = \&CatchWarning;
$gotWarning = 0;
eval { $result = $dbh->rollback; };
$SIG{__WARN__} = 'DEFAULT';
}
Test($state or $gotWarning or $dbh->err)
or ErrMsg("Missing warning when rolling back in AutoCommit mode");
#
# Finally drop the test table.
#
Test($state or $dbh->do("DROP TABLE $table"))
or ErrMsgF("Cannot DROP test table $table: %s.\n",
$dbh->errstr);
Test($state or $dbh->disconnect())
or ErrMsgF("Cannot DROP test table $table: %s.\n",
$dbh->errstr);
}
|
