here's a test that shows the memory leak
[dbsrgits/DBM-Deep.git] / t / 33_transactions.t
CommitLineData
fee0243f 1use strict;
2120a181 2use Test::More tests => 99;
42717e46 3use Test::Deep;
2120a181 4use Test::Exception;
fee0243f 5use t::common qw( new_fh );
6
7use_ok( 'DBM::Deep' );
8
9my ($fh, $filename) = new_fh();
21838116 10my $db1 = DBM::Deep->new(
fee0243f 11 file => $filename,
21838116 12 locking => 1,
c9b6d0d8 13 autoflush => 1,
2120a181 14 num_txns => 16,
fee0243f 15);
16
21838116 17my $db2 = DBM::Deep->new(
18 file => $filename,
19 locking => 1,
c9b6d0d8 20 autoflush => 1,
2120a181 21 num_txns => 16,
21838116 22);
23
24$db1->{x} = 'y';
25is( $db1->{x}, 'y', "Before transaction, DB1's X is Y" );
26is( $db2->{x}, 'y', "Before transaction, DB2's X is Y" );
27
2120a181 28cmp_bag( [ keys %$db1 ], [qw( x )], "DB1 keys correct" );
29cmp_bag( [ keys %$db2 ], [qw( x )], "DB2 keys correct" );
30
31throws_ok {
32 $db1->rollback;
33} qr/Cannot rollback without an active transaction/, "Attempting to rollback without a transaction throws an error";
34
35throws_ok {
36 $db1->commit;
37} qr/Cannot commit without an active transaction/, "Attempting to commit without a transaction throws an error";
38
21838116 39$db1->begin_work;
40
2120a181 41throws_ok {
42 $db1->begin_work;
43} qr/Cannot begin_work within an active transaction/, "Attempting to begin_work within a transaction throws an error";
44
45lives_ok {
46 $db1->rollback;
47} "Rolling back an empty transaction is ok.";
48
49cmp_bag( [ keys %$db1 ], [qw( x )], "DB1 keys correct" );
50cmp_bag( [ keys %$db2 ], [qw( x )], "DB2 keys correct" );
51
52$db1->begin_work;
53
54lives_ok {
55 $db1->commit;
56} "Committing an empty transaction is ok.";
57
58cmp_bag( [ keys %$db1 ], [qw( x )], "DB1 keys correct" );
59cmp_bag( [ keys %$db2 ], [qw( x )], "DB2 keys correct" );
60
61$db1->begin_work;
62
63 cmp_bag( [ keys %$db1 ], [qw( x )], "DB1 keys correct" );
64 cmp_bag( [ keys %$db2 ], [qw( x )], "DB2 keys correct" );
65
633df1fd 66 is( $db1->{x}, 'y', "DB1 transaction started, no actions - DB1's X is Y" );
67 is( $db2->{x}, 'y', "DB1 transaction started, no actions - DB2's X is Y" );
21838116 68
2120a181 69 $db2->{x} = 'a';
70 is( $db1->{x}, 'y', "Within DB1 transaction, DB1's X is still Y" );
71 is( $db2->{x}, 'a', "Within DB1 transaction, DB2's X is now A" );
72
633df1fd 73 $db1->{x} = 'z';
74 is( $db1->{x}, 'z', "Within DB1 transaction, DB1's X is Z" );
2120a181 75 is( $db2->{x}, 'a', "Within DB1 transaction, DB2's X is still A" );
76
77 $db1->{z} = 'a';
78 is( $db1->{z}, 'a', "Within DB1 transaction, DB1's Z is A" );
79 ok( !exists $db2->{z}, "Since z was added after the transaction began, DB2 doesn't see it." );
21838116 80
633df1fd 81 $db2->{other_x} = 'foo';
82 is( $db2->{other_x}, 'foo', "DB2 set other_x within DB1's transaction, so DB2 can see it" );
13ff93d5 83 ok( !exists $db1->{other_x}, "Since other_x was added after the transaction began, DB1 doesn't see it." );
21838116 84
2120a181 85 # Reset to an expected value
86 $db2->{x} = 'y';
87 is( $db1->{x}, 'z', "Within DB1 transaction, DB1's X is istill Z" );
88 is( $db2->{x}, 'y', "Within DB1 transaction, DB2's X is now Y" );
89
90 cmp_bag( [ keys %$db1 ], [qw( x z )], "DB1 keys correct" );
42717e46 91 cmp_bag( [ keys %$db2 ], [qw( x other_x )], "DB2 keys correct" );
92
21838116 93$db1->rollback;
94
95is( $db1->{x}, 'y', "After rollback, DB1's X is Y" );
96is( $db2->{x}, 'y', "After rollback, DB2's X is Y" );
97
98is( $db1->{other_x}, 'foo', "After DB1 transaction is over, DB1 can see other_x" );
99is( $db2->{other_x}, 'foo', "After DB1 transaction is over, DB2 can still see other_x" );
460b1067 100
6677de37 101$db1->begin_work;
102
2120a181 103 cmp_bag( [ keys %$db1 ], [qw( x other_x )], "DB1 keys correct" );
104 cmp_bag( [ keys %$db2 ], [qw( x other_x )], "DB2 keys correct" );
105
633df1fd 106 is( $db1->{x}, 'y', "DB1 transaction started, no actions - DB1's X is Y" );
107 is( $db2->{x}, 'y', "DB1 transaction started, no actions - DB2's X is Y" );
108
109 $db1->{x} = 'z';
110 is( $db1->{x}, 'z', "Within DB1 transaction, DB1's X is Z" );
111 is( $db2->{x}, 'y', "Within DB1 transaction, DB2's X is still Y" );
6677de37 112
504185fb 113 $db2->{other_x} = 'bar';
114 is( $db2->{other_x}, 'bar', "DB2 set other_x within DB1's transaction, so DB2 can see it" );
115 is( $db1->{other_x}, 'foo', "Since other_x was modified after the transaction began, DB1 doesn't see the change." );
116
2120a181 117 $db1->{z} = 'a';
118 is( $db1->{z}, 'a', "Within DB1 transaction, DB1's Z is A" );
119 ok( !exists $db2->{z}, "Since z was added after the transaction began, DB2 doesn't see it." );
120
121 cmp_bag( [ keys %$db1 ], [qw( x other_x z )], "DB1 keys correct" );
42717e46 122 cmp_bag( [ keys %$db2 ], [qw( x other_x )], "DB2 keys correct" );
123
6677de37 124$db1->commit;
125
126is( $db1->{x}, 'z', "After commit, DB1's X is Z" );
127is( $db2->{x}, 'z', "After commit, DB2's X is Z" );
128
2120a181 129is( $db1->{z}, 'a', "After commit, DB1's Z is A" );
130is( $db2->{z}, 'a', "After commit, DB2's Z is A" );
131
132is( $db1->{other_x}, 'bar', "After commit, DB1's other_x is bar" );
133is( $db2->{other_x}, 'bar', "After commit, DB2's other_x is bar" );
134
6677de37 135$db1->begin_work;
136
2120a181 137 cmp_bag( [ keys %$db1 ], [qw( x z other_x )], "DB1 keys correct" );
138 cmp_bag( [ keys %$db2 ], [qw( x z other_x )], "DB2 keys correct" );
139
140 is( $db1->{x}, 'z', "After commit, DB1's X is Z" );
141 is( $db2->{x}, 'z', "After commit, DB2's X is Z" );
142
143 is( $db1->{z}, 'a', "After commit, DB1's Z is A" );
144 is( $db2->{z}, 'a', "After commit, DB2's Z is A" );
145
146 is( $db1->{other_x}, 'bar', "After begin_work, DB1's other_x is still bar" );
147 is( $db2->{other_x}, 'bar', "After begin_work, DB2's other_x is still bar" );
148
633df1fd 149 delete $db2->{other_x};
94e8af14 150 ok( !exists $db2->{other_x}, "DB2 deleted other_x in DB1's transaction, so it can't see it anymore" );
504185fb 151 is( $db1->{other_x}, 'bar', "Since other_x was deleted after the transaction began, DB1 still sees it." );
6677de37 152
2120a181 153 cmp_bag( [ keys %$db1 ], [qw( x z other_x )], "DB1 keys correct" );
154 cmp_bag( [ keys %$db2 ], [qw( x z )], "DB2 keys correct" );
42717e46 155
633df1fd 156 delete $db1->{x};
94e8af14 157 ok( !exists $db1->{x}, "DB1 deleted X in a transaction, so it can't see it anymore" );
22e20cce 158 is( $db2->{x}, 'z', "But, DB2 can still see it" );
94e8af14 159
2120a181 160 cmp_bag( [ keys %$db1 ], [qw( other_x z )], "DB1 keys correct" );
161 cmp_bag( [ keys %$db2 ], [qw( x z )], "DB2 keys correct" );
42717e46 162
6677de37 163$db1->rollback;
164
42717e46 165ok( !exists $db2->{other_x}, "It's still deleted for DB2" );
166ok( !exists $db1->{other_x}, "And now DB1 sees the deletion" );
6677de37 167
168is( $db1->{x}, 'z', "The transaction was rolled back, so DB1 can see X now" );
169is( $db2->{x}, 'z', "DB2 can still see it" );
170
2120a181 171cmp_bag( [ keys %$db1 ], [qw( x z )], "DB1 keys correct" );
172cmp_bag( [ keys %$db2 ], [qw( x z )], "DB2 keys correct" );
42717e46 173
6677de37 174$db1->begin_work;
175
633df1fd 176 delete $db1->{x};
94e8af14 177 ok( !exists $db1->{x}, "DB1 deleted X in a transaction, so it can't see it anymore" );
2120a181 178
633df1fd 179 is( $db2->{x}, 'z', "But, DB2 can still see it" );
6677de37 180
2120a181 181 cmp_bag( [ keys %$db1 ], [qw( z )], "DB1 keys correct" );
182 cmp_bag( [ keys %$db2 ], [qw( x z )], "DB2 keys correct" );
42717e46 183
6677de37 184$db1->commit;
185
42717e46 186ok( !exists $db1->{x}, "The transaction was committed, so DB1 still deleted X" );
187ok( !exists $db2->{x}, "DB2 can now see the deletion of X" );
94e8af14 188
189$db1->{foo} = 'bar';
190is( $db1->{foo}, 'bar', "Set foo to bar in DB1" );
191is( $db2->{foo}, 'bar', "Set foo to bar in DB2" );
192
2120a181 193cmp_bag( [ keys %$db1 ], [qw( foo z )], "DB1 keys correct" );
194cmp_bag( [ keys %$db2 ], [qw( foo z )], "DB2 keys correct" );
42717e46 195
94e8af14 196$db1->begin_work;
197
198 %$db1 = (); # clear()
199 ok( !exists $db1->{foo}, "Cleared foo" );
200 is( $db2->{foo}, 'bar', "But in DB2, we can still see it" );
201
42717e46 202 cmp_bag( [ keys %$db1 ], [qw()], "DB1 keys correct" );
2120a181 203 cmp_bag( [ keys %$db2 ], [qw( foo z )], "DB2 keys correct" );
42717e46 204
94e8af14 205$db1->rollback;
206
207is( $db1->{foo}, 'bar', "Rollback means 'foo' is still there" );
208is( $db2->{foo}, 'bar', "Rollback means 'foo' is still there" );
42717e46 209
2120a181 210cmp_bag( [ keys %$db1 ], [qw( foo z )], "DB1 keys correct" );
211cmp_bag( [ keys %$db2 ], [qw( foo z )], "DB2 keys correct" );
42717e46 212
13ff93d5 213SKIP: {
45f047f8 214 skip "Optimize tests skipped on Win32", 7
13ff93d5 215 if $^O eq 'MSWin32' || $^O eq 'cygwin';
f9a320bb 216
13ff93d5 217 $db1->optimize;
42717e46 218
13ff93d5 219 is( $db1->{foo}, 'bar', 'After optimize, everything is ok' );
220 is( $db2->{foo}, 'bar', 'After optimize, everything is ok' );
42717e46 221
2120a181 222 is( $db1->{z}, 'a', 'After optimize, everything is ok' );
223 is( $db2->{z}, 'a', 'After optimize, everything is ok' );
224
225 cmp_bag( [ keys %$db1 ], [qw( foo z )], "DB1 keys correct" );
226 cmp_bag( [ keys %$db2 ], [qw( foo z )], "DB2 keys correct" );
42717e46 227
13ff93d5 228 $db1->begin_work;
42717e46 229
2120a181 230 cmp_ok( $db1->_engine->trans_id, '==', 1, "Transaction ID has been reset after optimize" );
13ff93d5 231
232 $db1->rollback;
233}
42717e46 234
235__END__