Commit | Line | Data |
12e7015a |
1 | # Test is sufficiently involved to *want* to run with "maximum paranoia" |
2 | BEGIN { $ENV{DBICTEST_OLD_MRO_SANITY_CHECK_ASSERTIONS} = 1 } |
3 | |
c0329273 |
4 | BEGIN { do "./t/lib/ANFANG.pm" or die ( $@ || $! ) } |
5 | |
471a5fdd |
6 | use strict; |
7 | use warnings; |
8 | |
9 | use Test::More; |
10 | use Test::Warn; |
11 | use Test::Exception; |
37f94f8d |
12 | |
13 | use List::Util 'shuffle'; |
14 | use DBIx::Class::_Util 'sigwarn_silencer'; |
15 | |
c0329273 |
16 | |
471a5fdd |
17 | use DBICTest; |
18 | |
19 | # Test txn_scope_guard |
20 | { |
21 | my $schema = DBICTest->init_schema(); |
22 | |
23 | is($schema->storage->transaction_depth, 0, "Correct transaction depth"); |
24 | my $artist_rs = $schema->resultset('Artist'); |
25 | |
26 | my $fn = __FILE__; |
27 | throws_ok { |
28 | my $guard = $schema->txn_scope_guard; |
29 | |
30 | $artist_rs->create({ |
31 | name => 'Death Cab for Cutie', |
32 | made_up_column => 1, |
33 | }); |
34 | |
35 | $guard->commit; |
e705f529 |
36 | } qr/No such column 'made_up_column' .*? at .*?\Q$fn\E line \d+/s, "Error propogated okay"; |
471a5fdd |
37 | |
38 | ok(!$artist_rs->find({name => 'Death Cab for Cutie'}), "Artist not created"); |
39 | |
40 | my $inner_exception = ''; # set in inner() below |
41 | throws_ok (sub { |
42 | outer($schema, 1); |
43 | }, qr/$inner_exception/, "Nested exceptions propogated"); |
44 | |
45 | ok(!$artist_rs->find({name => 'Death Cab for Cutie'}), "Artist not created"); |
46 | |
47 | lives_ok (sub { |
48 | |
49 | # this weird assignment is to stop perl <= 5.8.9 leaking $schema on nested sub{}s |
50 | my $s = $schema; |
51 | |
52 | warnings_exist ( sub { |
53 | # The 0 arg says don't die, just let the scope guard go out of scope |
54 | # forcing a txn_rollback to happen |
55 | outer($s, 0); |
56 | }, qr/A DBIx::Class::Storage::TxnScopeGuard went out of scope without explicit commit or error. Rolling back./, 'Out of scope warning detected'); |
57 | |
58 | ok(!$artist_rs->find({name => 'Death Cab for Cutie'}), "Artist not created"); |
59 | |
60 | }, 'rollback successful withot exception'); |
61 | |
62 | sub outer { |
63 | my ($schema, $fatal) = @_; |
64 | |
65 | my $guard = $schema->txn_scope_guard; |
66 | $schema->resultset('Artist')->create({ |
67 | name => 'Death Cab for Cutie', |
68 | }); |
69 | inner($schema, $fatal); |
70 | } |
71 | |
72 | sub inner { |
73 | my ($schema, $fatal) = @_; |
74 | |
75 | my $inner_guard = $schema->txn_scope_guard; |
76 | is($schema->storage->transaction_depth, 2, "Correct transaction depth"); |
77 | |
78 | my $artist = $schema->resultset('Artist')->find({ name => 'Death Cab for Cutie' }); |
79 | |
80 | eval { |
81 | $artist->cds->create({ |
82 | title => 'Plans', |
83 | year => 2005, |
84 | $fatal ? ( foo => 'bar' ) : () |
85 | }); |
86 | }; |
87 | if ($@) { |
88 | # Record what got thrown so we can test it propgates out properly. |
89 | $inner_exception = $@; |
90 | die $@; |
91 | } |
92 | |
93 | # inner guard should commit without consequences |
94 | $inner_guard->commit; |
95 | } |
96 | } |
97 | |
98 | # make sure the guard does not eat exceptions |
99 | { |
100 | my $schema = DBICTest->init_schema; |
101 | |
471a5fdd |
102 | no warnings 'redefine'; |
0d2033c3 |
103 | local *DBIx::Class::Storage::DBI::txn_rollback = sub { die 'die die my darling' }; |
87bf71d5 |
104 | Class::C3->reinitialize() if DBIx::Class::_ENV_::OLD_MRO; |
471a5fdd |
105 | |
106 | throws_ok (sub { |
107 | my $guard = $schema->txn_scope_guard; |
108 | $schema->resultset ('Artist')->create ({ name => 'bohhoo'}); |
109 | |
110 | # this should freak out the guard rollback |
111 | # but it won't work because DBD::SQLite is buggy |
112 | # instead just install a toxic rollback above |
113 | #$schema->storage->_dbh( $schema->storage->_dbh->clone ); |
114 | |
115 | die 'Deliberate exception'; |
750a4ad2 |
116 | }, ( "$]" >= 5.013008 ) |
e69b5335 |
117 | ? qr/Deliberate exception/s # temporary until we get the generic exception wrapper rolling |
118 | : qr/Deliberate exception.+Rollback failed/s |
119 | ); |
471a5fdd |
120 | |
121 | # just to mask off warning since we could not disconnect above |
122 | $schema->storage->_dbh->disconnect; |
123 | } |
124 | |
125 | # make sure it warns *big* on failed rollbacks |
f62c5724 |
126 | # test with and without a poisoned $@ |
37f94f8d |
127 | require DBICTest::AntiPattern::TrueZeroLen; |
128 | require DBICTest::AntiPattern::NullObject; |
129 | { |
471a5fdd |
130 | my @want = ( |
131 | qr/A DBIx::Class::Storage::TxnScopeGuard went out of scope without explicit commit or error. Rolling back./, |
132 | qr/\*+ ROLLBACK FAILED\!\!\! \*+/, |
133 | ); |
134 | |
135 | my @w; |
136 | local $SIG{__WARN__} = sub { |
137 | if (grep {$_[0] =~ $_} (@want)) { |
138 | push @w, $_[0]; |
139 | } |
140 | else { |
141 | warn $_[0]; |
142 | } |
143 | }; |
6e102c8f |
144 | |
5c33c8be |
145 | |
146 | # we are driving manually here, do not allow interference |
147 | local $SIG{__DIE__} if $SIG{__DIE__}; |
148 | |
149 | |
37f94f8d |
150 | no warnings 'redefine'; |
151 | local *DBIx::Class::Storage::DBI::txn_rollback = sub { die 'die die my darling' }; |
152 | Class::C3->reinitialize() if DBIx::Class::_ENV_::OLD_MRO; |
471a5fdd |
153 | |
37f94f8d |
154 | my @poisons = shuffle ( |
155 | undef, |
156 | DBICTest::AntiPattern::TrueZeroLen->new, |
157 | DBICTest::AntiPattern::NullObject->new, |
158 | 'GIFT!', |
159 | ); |
6e102c8f |
160 | |
37f94f8d |
161 | for my $pre_poison (@poisons) { |
162 | for my $post_poison (@poisons) { |
471a5fdd |
163 | |
37f94f8d |
164 | @w = (); |
165 | |
166 | my $schema = DBICTest->init_schema(no_populate => 1); |
167 | |
168 | # the actual scope where the guard is created/freed |
169 | { |
170 | # in this particular case these are not the warnings we are looking for |
171 | local $SIG{__WARN__} = sigwarn_silencer qr/implementing the so called null-object-pattern/; |
172 | |
173 | # if is inside the eval, to clear $@ in the undef case |
174 | eval { die $pre_poison if defined $pre_poison }; |
175 | |
176 | my $guard = $schema->txn_scope_guard; |
177 | |
178 | eval { die $post_poison if defined $post_poison }; |
179 | |
180 | $schema->resultset ('Artist')->create ({ name => "bohhoo, too bad we'll roll you back"}); |
181 | } |
182 | |
183 | local $TODO = 'Do not know how to deal with trapped exceptions occuring after guard instantiation...' |
184 | if ( defined $post_poison and ( |
185 | # take no chances on installation |
186 | DBICTest::RunMode->is_plain |
187 | or |
188 | # I do not understand why but on <= 5.8.8 and on 5.10.0 |
189 | # "$pre_poison == $post_poison == string" passes... |
190 | # so todoify 5.8.9 and 5.10.1+, and deal with the rest below |
191 | ( ( "$]" > 5.008008 and "$]" < 5.010000 ) or "$]" > 5.010000 ) |
192 | or |
193 | ! defined $pre_poison |
194 | or |
195 | length ref $pre_poison |
196 | or |
197 | length ref $post_poison |
198 | )); |
199 | |
200 | is (@w, 2, sprintf 'Both expected warnings found - $@ poisonstate: pre-poison:%s post-poison:%s', |
201 | map { |
202 | ! defined $_ ? 'UNDEF' |
203 | : ! length ref $_ ? $_ |
204 | : ref $_ |
205 | |
206 | } ($pre_poison, $post_poison) |
207 | ); |
208 | |
209 | # just to mask off warning since we could not disconnect above |
210 | $schema->storage->_dbh->disconnect; |
211 | } |
212 | } |
213 | } |
471a5fdd |
214 | |
153a6b38 |
215 | # add a TODO to catch when Text::Balanced is finally fixed |
216 | # https://rt.cpan.org/Public/Bug/Display.html?id=74994 |
217 | # |
218 | # while it doesn't matter much for DBIC itself, this particular bug |
219 | # is a *BANE*, and DBIC is to bump its dep as soon as possible |
220 | { |
221 | |
222 | require Text::Balanced; |
223 | |
841efcb3 |
224 | my @w; |
225 | local $SIG{__WARN__} = sub { |
9bea2000 |
226 | $_[0] =~ /External exception class .+? \Qimplements partial (broken) overloading/ |
841efcb3 |
227 | ? push @w, @_ |
228 | : warn @_ |
229 | }; |
153a6b38 |
230 | |
841efcb3 |
231 | lives_ok { |
232 | # this is what poisons $@ |
233 | Text::Balanced::extract_bracketed( '(foo', '()' ); |
35cf7d1a |
234 | DBIx::Class::_Util::is_exception($@); |
153a6b38 |
235 | |
841efcb3 |
236 | my $s = DBICTest::Schema->connect('dbi:SQLite::memory:'); |
237 | my $g = $s->txn_scope_guard; |
238 | $g->commit; |
239 | } 'Broken Text::Balanced is not screwing up txn_guard'; |
153a6b38 |
240 | |
841efcb3 |
241 | local $TODO = 'RT#74994 *STILL* not fixed'; |
242 | is(scalar @w, 0, 'no warnings \o/'); |
153a6b38 |
243 | } |
244 | |
471a5fdd |
245 | done_testing; |