X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=t%2Fstorage%2Ftxn_scope_guard.t;h=00d81a46df9b04ff8099bb2a0b5b67e6c0685aa7;hb=HEAD;hp=b2bdbe59b03d75fd41000c804881faed05b3134e;hpb=6e102c8f57949f9318da1ff12e33d3a652e3d93c;p=dbsrgits%2FDBIx-Class.git diff --git a/t/storage/txn_scope_guard.t b/t/storage/txn_scope_guard.t index b2bdbe5..00d81a4 100644 --- a/t/storage/txn_scope_guard.t +++ b/t/storage/txn_scope_guard.t @@ -1,10 +1,19 @@ +# Test is sufficiently involved to *want* to run with "maximum paranoia" +BEGIN { $ENV{DBICTEST_OLD_MRO_SANITY_CHECK_ASSERTIONS} = 1 } + +BEGIN { do "./t/lib/ANFANG.pm" or die ( $@ || $! ) } + use strict; use warnings; use Test::More; use Test::Warn; use Test::Exception; -use lib qw(t/lib); + +use List::Util 'shuffle'; +use DBIx::Class::_Util 'sigwarn_silencer'; + + use DBICTest; # Test txn_scope_guard @@ -90,10 +99,8 @@ use DBICTest; { my $schema = DBICTest->init_schema; - no strict 'refs'; no warnings 'redefine'; - - local *{DBIx::Class::Storage::DBI::txn_rollback} = sub { die 'die die my darling' }; + local *DBIx::Class::Storage::DBI::txn_rollback = sub { die 'die die my darling' }; Class::C3->reinitialize() if DBIx::Class::_ENV_::OLD_MRO; throws_ok (sub { @@ -106,7 +113,7 @@ use DBICTest; #$schema->storage->_dbh( $schema->storage->_dbh->clone ); die 'Deliberate exception'; - }, ($] >= 5.013008 ) + }, ( "$]" >= 5.013008 ) ? qr/Deliberate exception/s # temporary until we get the generic exception wrapper rolling : qr/Deliberate exception.+Rollback failed/s ); @@ -117,37 +124,9 @@ use DBICTest; # make sure it warns *big* on failed rollbacks # test with and without a poisoned $@ -for my $pre_poison (0,1) { -for my $post_poison (0,1) { - - my $schema = DBICTest->init_schema(no_populate => 1); - - no strict 'refs'; - no warnings 'redefine'; - local *{DBIx::Class::Storage::DBI::txn_rollback} = sub { die 'die die my darling' }; - Class::C3->reinitialize() if DBIx::Class::_ENV_::OLD_MRO; - -#The warn from within a DESTROY callback freaks out Test::Warn, do it old-school -=begin - warnings_exist ( - sub { - my $guard = $schema->txn_scope_guard; - $schema->resultset ('Artist')->create ({ name => 'bohhoo'}); - - # this should freak out the guard rollback - # but it won't work because DBD::SQLite is buggy - # instead just install a toxic rollback above - #$schema->storage->_dbh( $schema->storage->_dbh->clone ); - }, - [ - qr/A DBIx::Class::Storage::TxnScopeGuard went out of scope without explicit commit or error. Rolling back./, - qr/\*+ ROLLBACK FAILED\!\!\! \*+/, - ], - 'proper warnings generated on out-of-scope+rollback failure' - ); -=cut - -# delete this once the above works properly (same test) +require DBICTest::AntiPattern::TrueZeroLen; +require DBICTest::AntiPattern::NullObject; +{ my @want = ( qr/A DBIx::Class::Storage::TxnScopeGuard went out of scope without explicit commit or error. Rolling back./, qr/\*+ ROLLBACK FAILED\!\!\! \*+/, @@ -163,29 +142,104 @@ for my $post_poison (0,1) { } }; - { - eval { die 'pre-GIFT!' if $pre_poison }; - my $guard = $schema->txn_scope_guard; - eval { die 'post-GIFT!' if $post_poison }; - $schema->resultset ('Artist')->create ({ name => 'bohhoo'}); + + # we are driving manually here, do not allow interference + local $SIG{__DIE__} if $SIG{__DIE__}; + + + no warnings 'redefine'; + local *DBIx::Class::Storage::DBI::txn_rollback = sub { die 'die die my darling' }; + Class::C3->reinitialize() if DBIx::Class::_ENV_::OLD_MRO; + + my @poisons = shuffle ( + undef, + DBICTest::AntiPattern::TrueZeroLen->new, + DBICTest::AntiPattern::NullObject->new, + 'GIFT!', + ); + + for my $pre_poison (@poisons) { + for my $post_poison (@poisons) { + + @w = (); + + my $schema = DBICTest->init_schema(no_populate => 1); + + # the actual scope where the guard is created/freed + { + # in this particular case these are not the warnings we are looking for + local $SIG{__WARN__} = sigwarn_silencer qr/implementing the so called null-object-pattern/; + + # if is inside the eval, to clear $@ in the undef case + eval { die $pre_poison if defined $pre_poison }; + + my $guard = $schema->txn_scope_guard; + + eval { die $post_poison if defined $post_poison }; + + $schema->resultset ('Artist')->create ({ name => "bohhoo, too bad we'll roll you back"}); + } + + local $TODO = 'Do not know how to deal with trapped exceptions occuring after guard instantiation...' + if ( defined $post_poison and ( + # take no chances on installation + DBICTest::RunMode->is_plain + or + # I do not understand why but on <= 5.8.8 and on 5.10.0 + # "$pre_poison == $post_poison == string" passes... + # so todoify 5.8.9 and 5.10.1+, and deal with the rest below + ( ( "$]" > 5.008008 and "$]" < 5.010000 ) or "$]" > 5.010000 ) + or + ! defined $pre_poison + or + length ref $pre_poison + or + length ref $post_poison + )); + + is (@w, 2, sprintf 'Both expected warnings found - $@ poisonstate: pre-poison:%s post-poison:%s', + map { + ! defined $_ ? 'UNDEF' + : ! length ref $_ ? $_ + : ref $_ + + } ($pre_poison, $post_poison) + ); + + # just to mask off warning since we could not disconnect above + $schema->storage->_dbh->disconnect; + } } +} - local $TODO = 'Do not know how to deal with trapped exceptions occuring after guard instantiation...' - if ( $post_poison and ( - # take no chances on installation - ( DBICTest::RunMode->is_plain and ($ENV{TRAVIS}||'') ne 'true' ) - or - # this always fails - ! $pre_poison - or - # I do not underdtand why but on <= 5.8.8 and $pre_poison && $post_poison passes... - $] > 5.008008 - )); +# add a TODO to catch when Text::Balanced is finally fixed +# https://rt.cpan.org/Public/Bug/Display.html?id=74994 +# +# while it doesn't matter much for DBIC itself, this particular bug +# is a *BANE*, and DBIC is to bump its dep as soon as possible +{ - is (@w, 2, "Both expected warnings found - \$\@ pre-poison: $pre_poison, post-poison: $post_poison" ); + require Text::Balanced; - # just to mask off warning since we could not disconnect above - $schema->storage->_dbh->disconnect; -}} + my @w; + local $SIG{__WARN__} = sub { + $_[0] =~ /External exception class .+? \Qimplements partial (broken) overloading/ + ? push @w, @_ + : warn @_ + }; + + lives_ok { + # this is what poisons $@ + Text::Balanced::extract_bracketed( '(foo', '()' ); + DBIx::Class::_Util::is_exception($@); + + my $s = DBICTest::Schema->connect('dbi:SQLite::memory:'); + my $g = $s->txn_scope_guard; + $g->commit; + } 'Broken Text::Balanced is not screwing up txn_guard'; + + local $TODO = 'RT#74994 *STILL* not fixed'; + is(scalar @w, 0, 'no warnings \o/'); +} done_testing;