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
|
#!/usr/bin/perl -w
#
#
# This is a test for ib_set_tx_param() private method.
#
# 2011-01-29 stefan(s. bv)
# New version based on t/testlib.pl and Firebird.dbtest
# Note: set_tx_param() is obsoleted by ib_set_tx_param().
#
# Transaction behavior default parameter values:
# Access mode: read_write
# Isolation level: snapshot
# Lock resolution: wait
use strict;
use warnings;
use Test::More;
use DBI;
use lib 't','.';
use TestFirebird;
my $T = TestFirebird->new;
my ( $dbh1, $error_str1 ) =
$T->connect_to_database( { ChopBlanks => 1 } );
if ($error_str1) {
BAIL_OUT("Unknown: $error_str1!");
}
else {
plan tests => 22;
}
unless ( $dbh1->isa('DBI::db') ) {
plan skip_all => 'Connection to database failed, cannot continue testing';
}
ok($dbh1, 'Connected to the database (1)');
my ( $dbh2, $error_str2 ) =
$T->connect_to_database( { ChopBlanks => 1 } );
ok($dbh2, 'Connected to the database (2)');
# DBI->trace(4, "trace.txt");
# ------- TESTS ------------------------------------------------------------- #
#
# Find a possible new table name
#
my $table = find_new_table($dbh1);
ok($table, "TABLE is '$table'");
#
# Create a new table
#
my $def =<<"DEF";
CREATE TABLE $table (
id INTEGER PRIMARY KEY,
name VARCHAR(20)
)
DEF
ok( $dbh1->do($def), qq{CREATE TABLE '$table'} );
#
# Changes transaction params
#
ok(
$dbh1->func(
-access_mode => 'read_write',
-isolation_level => 'read_committed',
-lock_resolution => 'wait',
'ib_set_tx_param'
),
'SET tx param for dbh 1'
);
ok(
$dbh2->func(
-access_mode => 'read_only',
-lock_resolution => 'no_wait',
'ib_set_tx_param'
),
'SET tx param for dbh 2'
);
SCOPE: {
local $dbh1->{AutoCommit} = 0;
local $dbh2->{PrintError} = 0;
my $insert_stmt = qq{ INSERT INTO $table VALUES(?, 'Yustina') };
my $select_stmt = qq{ SELECT * FROM $table WHERE 1 = 0 };
ok(my $sth2 = $dbh2->prepare($select_stmt), 'PREPARE SELECT');
ok($dbh1->do($insert_stmt, undef, 1), 'DO INSERT (1)');
#- Expected failure ( -access_mode => 'read_only' )
eval {
$dbh2->do($insert_stmt, undef, 2);
};
ok($@, "DO INSERT (2) Expected failure ('read_only' )");
#- Reading should be ok here
ok($sth2->execute, 'EXECUTE sth 2');
ok($sth2->finish, 'FINISH sth 2');
#- Committing the first trans
ok($dbh1->commit, 'COMMIT dbh 1');
ok(
$dbh1->func(
-access_mode => 'read_write',
-isolation_level => 'read_committed',
-lock_resolution => 'wait',
-reserving => {
$table => {
lock => 'write',
access => 'protected',
},
},
'ib_set_tx_param'
),
'CHANGE tx param for dbh 1'
);
ok(
$dbh2->func(
-lock_resolution => 'no_wait',
'ib_set_tx_param'
),
'CHANGE tx param for dbh 2'
);
ok($dbh1->do($insert_stmt, undef, 3), 'DO INSERT (2)');
#- Expected failure ( -lock_resolution => 'no_wait' )
eval {
$dbh2->do($insert_stmt, undef, 4);
};
ok($@, "DO INSERT (3) Expected failure ('no_wait')");
# Committing the first trans
ok($dbh1->commit, 'COMMIT dbh 1');
}
#
# Drop the test table
#
isa_ok( $dbh1, 'DBI::db' );
isa_ok( $dbh2, 'DBI::db' );
#
# Disconnect 2
ok($dbh2->disconnect, 'DISCONNECT 2');
# AutoCommit is on
ok( $dbh1->do("DROP TABLE $table"), "DROP TABLE '$table'" );
#
# Finally disconnect 1
#
ok($dbh1->disconnect, 'DISCONNECT 1');
|
