From: Peter Rabbitson Date: Thu, 4 Apr 2013 02:20:39 +0000 (+0200) Subject: Extra TODO tests for a txn_guard silencing problem X-Git-Tag: v0.08210~6 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=6e102c8f;p=dbsrgits%2FDBIx-Class.git Extra TODO tests for a txn_guard silencing problem --- diff --git a/lib/DBIx/Class/Storage.pm b/lib/DBIx/Class/Storage.pm index 6b88d28..f5f2951 100644 --- a/lib/DBIx/Class/Storage.pm +++ b/lib/DBIx/Class/Storage.pm @@ -470,6 +470,8 @@ sub debugobj { $self->{debugobj} ||= do { if (my $profile = $ENV{DBIC_TRACE_PROFILE}) { require DBIx::Class::Storage::Debug::PrettyPrint; + my @pp_args; + if ($profile =~ /^\.?\//) { require Config::Any; @@ -481,10 +483,28 @@ sub debugobj { $self->throw_exception("Failure processing \$ENV{DBIC_TRACE_PROFILE}: $_"); }; - DBIx::Class::Storage::Debug::PrettyPrint->new(values %{$cfg->[0]}); + @pp_args = values %{$cfg->[0]}; } else { - DBIx::Class::Storage::Debug::PrettyPrint->new({ profile => $profile }); + @pp_args = { profile => $profile }; + } + + # FIXME - FRAGILE + # Hash::Merge is a sorry piece of shit and tramples all over $@ + # *without* throwing an exception + # This is a rather serious problem in the debug codepath + # Insulate the condition here with a try{} until a review of + # DBIx::Class::Storage::Debug::PrettyPrint takes place + # we do rethrow the error unconditionally, the only reason + # to try{} is to preserve the precise state of $@ (down + # to the scalar (if there is one) address level) + # + # Yes I am aware this is fragile and TxnScopeGuard needs + # a better fix. This is another yak to shave... :( + try { + DBIx::Class::Storage::Debug::PrettyPrint->new(@pp_args); + } catch { + $self->throw_exception($_); } } else { diff --git a/lib/DBIx/Class/Storage/TxnScopeGuard.pm b/lib/DBIx/Class/Storage/TxnScopeGuard.pm index 18e2260..580a32b 100644 --- a/lib/DBIx/Class/Storage/TxnScopeGuard.pm +++ b/lib/DBIx/Class/Storage/TxnScopeGuard.pm @@ -19,15 +19,19 @@ sub new { # we are starting with an already set $@ - in order for things to work we need to # be able to recognize it upon destruction - store its weakref # recording it before doing the txn_begin stuff + # + # FIXME FRAGILE - any eval that fails but *does not* rethrow between here + # and the unwind will trample over $@ and invalidate the entire mechanism + # There got to be a saner way of doing this... if (defined $@ and $@ ne '') { - $guard->{existing_exception_ref} = (ref $@ ne '') ? $@ : \$@; - weaken $guard->{existing_exception_ref}; + weaken( + $guard->{existing_exception_ref} = (ref $@ ne '') ? $@ : \$@ + ); } $storage->txn_begin; - $guard->{dbh} = $storage->_dbh; - weaken $guard->{dbh}; + weaken( $guard->{dbh} = $storage->_dbh ); bless $guard, ref $class || $class; diff --git a/t/storage/txn_scope_guard.t b/t/storage/txn_scope_guard.t index c0cb347..b2bdbe5 100644 --- a/t/storage/txn_scope_guard.t +++ b/t/storage/txn_scope_guard.t @@ -117,9 +117,10 @@ use DBICTest; # make sure it warns *big* on failed rollbacks # test with and without a poisoned $@ -for my $poison (0,1) { +for my $pre_poison (0,1) { +for my $post_poison (0,1) { - my $schema = DBICTest->init_schema(); + my $schema = DBICTest->init_schema(no_populate => 1); no strict 'refs'; no warnings 'redefine'; @@ -161,16 +162,30 @@ for my $poison (0,1) { warn $_[0]; } }; + { - eval { die 'GIFT!' if $poison }; - my $guard = $schema->txn_scope_guard; - $schema->resultset ('Artist')->create ({ name => 'bohhoo'}); + 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'}); } - is (@w, 2, 'Both expected warnings found' . ($poison ? ' (after $@ poisoning)' : '') ); + 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 + )); + + is (@w, 2, "Both expected warnings found - \$\@ pre-poison: $pre_poison, post-poison: $post_poison" ); # just to mask off warning since we could not disconnect above $schema->storage->_dbh->disconnect; -} +}} done_testing;