Added a comment as to where an allocation error is occurring that crashes perl
[dbsrgits/DBM-Deep.git] / t / 33_transactions.t
1 use strict;
2 use Test::More tests => 99;
3 use Test::Deep;
4 use Test::Exception;
5 use t::common qw( new_fh );
6
7 use_ok( 'DBM::Deep' );
8
9 my ($fh, $filename) = new_fh();
10 my $db1 = DBM::Deep->new(
11     file => $filename,
12     locking => 1,
13     autoflush => 1,
14     num_txns  => 16,
15 );
16
17 my $db2 = DBM::Deep->new(
18     file => $filename,
19     locking => 1,
20     autoflush => 1,
21     num_txns  => 16,
22 );
23
24 $db1->{x} = 'y';
25 is( $db1->{x}, 'y', "Before transaction, DB1's X is Y" );
26 is( $db2->{x}, 'y', "Before transaction, DB2's X is Y" );
27
28 cmp_bag( [ keys %$db1 ], [qw( x )], "DB1 keys correct" );
29 cmp_bag( [ keys %$db2 ], [qw( x )], "DB2 keys correct" );
30
31 throws_ok {
32     $db1->rollback;
33 } qr/Cannot rollback without an active transaction/, "Attempting to rollback without a transaction throws an error";
34
35 throws_ok {
36     $db1->commit;
37 } qr/Cannot commit without an active transaction/, "Attempting to commit without a transaction throws an error";
38
39 $db1->begin_work;
40
41 throws_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
45 lives_ok {
46     $db1->rollback;
47 } "Rolling back an empty transaction is ok.";
48
49 cmp_bag( [ keys %$db1 ], [qw( x )], "DB1 keys correct" );
50 cmp_bag( [ keys %$db2 ], [qw( x )], "DB2 keys correct" );
51
52 $db1->begin_work;
53
54 lives_ok {
55     $db1->commit;
56 } "Committing an empty transaction is ok.";
57
58 cmp_bag( [ keys %$db1 ], [qw( x )], "DB1 keys correct" );
59 cmp_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
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" );
68
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
73     $db1->{x} = 'z';
74     is( $db1->{x}, 'z', "Within DB1 transaction, DB1's X is Z" );
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." );
80
81     $db2->{other_x} = 'foo';
82     is( $db2->{other_x}, 'foo', "DB2 set other_x within DB1's transaction, so DB2 can see it" );
83     ok( !exists $db1->{other_x}, "Since other_x was added after the transaction began, DB1 doesn't see it." );
84
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" );
91     cmp_bag( [ keys %$db2 ], [qw( x other_x )], "DB2 keys correct" );
92
93 $db1->rollback;
94
95 is( $db1->{x}, 'y', "After rollback, DB1's X is Y" );
96 is( $db2->{x}, 'y', "After rollback, DB2's X is Y" );
97
98 is( $db1->{other_x}, 'foo', "After DB1 transaction is over, DB1 can see other_x" );
99 is( $db2->{other_x}, 'foo', "After DB1 transaction is over, DB2 can still see other_x" );
100
101 $db1->begin_work;
102
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
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" );
112
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
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" );
122     cmp_bag( [ keys %$db2 ], [qw( x other_x )], "DB2 keys correct" );
123
124 $db1->commit;
125
126 is( $db1->{x}, 'z', "After commit, DB1's X is Z" );
127 is( $db2->{x}, 'z', "After commit, DB2's X is Z" );
128
129 is( $db1->{z}, 'a', "After commit, DB1's Z is A" );
130 is( $db2->{z}, 'a', "After commit, DB2's Z is A" );
131
132 is( $db1->{other_x}, 'bar', "After commit, DB1's other_x is bar" );
133 is( $db2->{other_x}, 'bar', "After commit, DB2's other_x is bar" );
134
135 $db1->begin_work;
136
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
149     delete $db2->{other_x};
150     ok( !exists $db2->{other_x}, "DB2 deleted other_x in DB1's transaction, so it can't see it anymore" );
151     is( $db1->{other_x}, 'bar', "Since other_x was deleted after the transaction began, DB1 still sees it." );
152
153     cmp_bag( [ keys %$db1 ], [qw( x z other_x )], "DB1 keys correct" );
154     cmp_bag( [ keys %$db2 ], [qw( x z )], "DB2 keys correct" );
155
156     delete $db1->{x};
157     ok( !exists $db1->{x}, "DB1 deleted X in a transaction, so it can't see it anymore" );
158     is( $db2->{x}, 'z', "But, DB2 can still see it" );
159
160     cmp_bag( [ keys %$db1 ], [qw( other_x z )], "DB1 keys correct" );
161     cmp_bag( [ keys %$db2 ], [qw( x z )], "DB2 keys correct" );
162
163 $db1->rollback;
164
165 ok( !exists $db2->{other_x}, "It's still deleted for DB2" );
166 ok( !exists $db1->{other_x}, "And now DB1 sees the deletion" );
167
168 is( $db1->{x}, 'z', "The transaction was rolled back, so DB1 can see X now" );
169 is( $db2->{x}, 'z', "DB2 can still see it" );
170
171 cmp_bag( [ keys %$db1 ], [qw( x z )], "DB1 keys correct" );
172 cmp_bag( [ keys %$db2 ], [qw( x z )], "DB2 keys correct" );
173
174 $db1->begin_work;
175
176     delete $db1->{x};
177     ok( !exists $db1->{x}, "DB1 deleted X in a transaction, so it can't see it anymore" );
178
179     is( $db2->{x}, 'z', "But, DB2 can still see it" );
180
181     cmp_bag( [ keys %$db1 ], [qw( z )], "DB1 keys correct" );
182     cmp_bag( [ keys %$db2 ], [qw( x z )], "DB2 keys correct" );
183
184 $db1->commit;
185
186 ok( !exists $db1->{x}, "The transaction was committed, so DB1 still deleted X" );
187 ok( !exists $db2->{x}, "DB2 can now see the deletion of X" );
188
189 $db1->{foo} = 'bar';
190 is( $db1->{foo}, 'bar', "Set foo to bar in DB1" );
191 is( $db2->{foo}, 'bar', "Set foo to bar in DB2" );
192
193 cmp_bag( [ keys %$db1 ], [qw( foo z )], "DB1 keys correct" );
194 cmp_bag( [ keys %$db2 ], [qw( foo z )], "DB2 keys correct" );
195
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
202     cmp_bag( [ keys %$db1 ], [qw()], "DB1 keys correct" );
203     cmp_bag( [ keys %$db2 ], [qw( foo z )], "DB2 keys correct" );
204
205 $db1->rollback;
206
207 is( $db1->{foo}, 'bar', "Rollback means 'foo' is still there" );
208 is( $db2->{foo}, 'bar', "Rollback means 'foo' is still there" );
209
210 cmp_bag( [ keys %$db1 ], [qw( foo z )], "DB1 keys correct" );
211 cmp_bag( [ keys %$db2 ], [qw( foo z )], "DB2 keys correct" );
212
213 SKIP: {
214     skip "Optimize tests skipped on Win32", 7
215         if $^O eq 'MSWin32' || $^O eq 'cygwin';
216
217     $db1->optimize;
218
219     is( $db1->{foo}, 'bar', 'After optimize, everything is ok' );
220     is( $db2->{foo}, 'bar', 'After optimize, everything is ok' );
221
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" );
227
228     $db1->begin_work;
229
230         cmp_ok( $db1->_engine->trans_id, '==', 1, "Transaction ID has been reset after optimize" );
231
232     $db1->rollback;
233 }
234
235 __END__