X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=t%2Fstorage%2Ftxn.t;h=ea9845fff2deb2ec0682caabbaeffcb20d7a00ad;hb=e240b8ba6a26e17bed8e87235bcc201eefca350d;hp=895eaaa8ba91dd3854c0b5cc0190afaeb9134b2a;hpb=ec6415a9f63389db5a76f593c2d1686015ca95cd;p=dbsrgits%2FDBIx-Class.git diff --git a/t/storage/txn.t b/t/storage/txn.t index 895eaaa..ea9845f 100644 --- a/t/storage/txn.t +++ b/t/storage/txn.t @@ -26,16 +26,17 @@ my $code = sub { (ref $schema)->txn_do(sub{}); }, qr/storage/, "can't call txn_do without storage"); - throws_ok ( sub { + throws_ok { $schema->txn_do(''); - }, qr/must be a CODE reference/, '$coderef parameter check ok'); + } qr/\Qrun() requires a coderef to execute as its first argument/, + '$coderef parameter check ok'; } # Test successful txn_do() - scalar/list context for my $want (0,1) { my $schema = DBICTest->init_schema; - is( $schema->storage->{transaction_depth}, 0, 'txn depth starts at 0'); + is( $schema->storage->transaction_depth, 0, 'txn depth starts at 0'); my @titles = map {'txn_do test CD ' . $_} (1..5); my $artist = $schema->resultset('Artist')->find(1); @@ -55,7 +56,7 @@ for my $want (0,1) { title => "txn_do test CD $_", })->first->year, 2006, "new CD $_ year correct") for (1..5); - is( $schema->storage->{transaction_depth}, 0, 'txn depth has been reset'); + is( $schema->storage->transaction_depth, 0, 'txn depth has been reset'); } # Test txn_do() @_ aliasing support @@ -71,7 +72,7 @@ for my $want (0,1) { { my $schema = DBICTest->init_schema; - is( $schema->storage->{transaction_depth}, 0, 'txn depth starts at 0'); + is( $schema->storage->transaction_depth, 0, 'txn depth starts at 0'); my $nested_code = sub { my ($schema, $artist, $code) = @_; @@ -95,7 +96,7 @@ for my $want (0,1) { })->first->year, 2006, qq{nested txn_do CD$_ year ok}) for (1..10); is($artist->cds->count, $count_before+10, 'nested txn_do added all CDs'); - is( $schema->storage->{transaction_depth}, 0, 'txn depth has been reset'); + is( $schema->storage->transaction_depth, 0, 'txn depth has been reset'); } # test nested txn_begin on fresh connection @@ -106,13 +107,14 @@ for my $want (0,1) { is ($schema->storage->transaction_depth, 0, 'Start outside txn'); my @pids; + SKIP: for my $action ( sub { my $s = shift; die "$$ starts in txn!" if $s->storage->transaction_depth != 0; $s->txn_do ( sub { die "$$ not in txn!" if $s->storage->transaction_depth == 0; - $s->storage->dbh->do('SELECT 1') } + $s->storage->dbh->do('SELECT 1') } ); die "$$ did not finish txn!" if $s->storage->transaction_depth != 0; }, @@ -128,8 +130,13 @@ for my $want (0,1) { }, ) { my $pid = fork(); - die "Unable to fork: $!\n" - if ! defined $pid; + + if( ! defined $pid ) { + skip "EAGAIN encountered, your system is likely bogged down: skipping forking test", 1 + if $! == Errno::EAGAIN(); + + die "Unable to fork: $!" + } if ($pid) { push @pids, $pid; @@ -160,13 +167,13 @@ for my $want (0,1) { my $guard = $schema->txn_scope_guard; $schema->txn_do( sub { die } ); }; + is( $schema->storage->transaction_depth, 0, 'Transaction successfully aborted' ); $schema->txn_do( sub { ok ($schema->storage->_dbh->do ('SELECT 1'), "Query after exceptions ok ($_)"); }); } $schema->txn_do ( sub { _test_forking_action ($schema, $pass) } ); - } } @@ -182,6 +189,7 @@ for my $want (0,1) { my $guard = $schema->txn_scope_guard; $schema->txn_do( sub { die } ); }; + is( $schema->storage->transaction_depth, 0, 'Transaction successfully aborted' ); $schema->txn_do( sub { ok ($schema->storage->_dbh->do ('SELECT 1'), "Query after exceptions ok ($_)"); }); @@ -204,8 +212,13 @@ sub _test_forking_action { if $^O eq 'MSWin32'; my $pid = fork(); - die "Unable to fork: $!\n" - if ! defined $pid; + if( ! defined $pid ) { + + skip "EAGAIN encountered, your system is likely bogged down: skipping forking test", 1 + if $! == Errno::EAGAIN(); + + die "Unable to fork: $!" + } if ($pid) { push @pids, $pid; @@ -233,6 +246,12 @@ sub _test_forking_action { for my $pid (@pids) { waitpid ($pid, 0); ok (! $?, "Child $pid exit ok (pass $pass)"); + } + + # it is important to reap all children before checking the final db-state + # otherwise a deadlock may occur between the transactions running in the + # children and the query of the parent + for my $pid (@pids) { isa_ok ($schema->resultset ('Artist')->find ({ name => "forking action $pid" }), 'DBIx::Class::Row'); } } @@ -252,7 +271,7 @@ my $fail_code = sub { # Test failed txn_do() for my $pass (1,2) { - is( $schema->storage->{transaction_depth}, 0, "txn depth starts at 0 (pass $pass)"); + is( $schema->storage->transaction_depth, 0, "txn depth starts at 0 (pass $pass)"); my $artist = $schema->resultset('Artist')->find(3); @@ -266,25 +285,25 @@ my $fail_code = sub { })->first; ok(!defined($cd), qq{failed txn_do didn't change the cds table (pass $pass)}); - is( $schema->storage->{transaction_depth}, 0, "txn depth has been reset (pass $pass)"); + is( $schema->storage->transaction_depth, 0, "txn depth has been reset (pass $pass)"); } # Test failed txn_do() with failed rollback { - is( $schema->storage->{transaction_depth}, 0, 'txn depth starts at 0'); + is( $schema->storage->transaction_depth, 0, 'txn depth starts at 0'); my $artist = $schema->resultset('Artist')->find(3); # Force txn_rollback() to throw an exception - no warnings 'redefine'; - no strict 'refs'; + no warnings qw/once redefine/; + + # this should logically work just fine - but it does not, + # only direct override of the existing method dtrt + #local *DBIx::Class::Storage::DBI::SQLite::txn_rollback = sub { die 'FAILED' }; - # die in rollback - local *{"DBIx::Class::Storage::DBI::SQLite::txn_rollback"} = sub{ - my $storage = shift; - die 'FAILED'; - }; + local *DBIx::Class::Storage::DBI::txn_rollback = sub { die 'FAILED' }; + Class::C3->reinitialize() if DBIx::Class::_ENV_::OLD_MRO; throws_ok ( sub { @@ -314,7 +333,7 @@ my $fail_code = sub { { my $schema = DBICTest->init_schema(); - is( $schema->storage->{transaction_depth}, 0, 'txn depth starts at 0'); + is( $schema->storage->transaction_depth, 0, 'txn depth starts at 0'); my $nested_fail_code = sub { my ($schema, $artist, $code1, $code2) = @_; @@ -342,7 +361,9 @@ my $fail_code = sub { ok(!defined($cd), q{failed txn_do didn't add failed txn's cd}); } + # Grab a new schema to test txn before connect +# also test nested txn exception { my $schema = DBICTest->init_schema(no_deploy => 1); lives_ok (sub { @@ -350,16 +371,15 @@ my $fail_code = sub { $schema->txn_begin(); }, 'Pre-connection nested transactions.'); - # although not connected DBI would still warn about rolling back at disconnect - $schema->txn_rollback; - $schema->txn_rollback; + throws_ok( sub { $schema->txn_rollback }, 'DBIx::Class::Storage::NESTED_ROLLBACK_EXCEPTION', 'got proper nested rollback exception' ); } # make sure AutoCommit => 0 on external handles behaves correctly with scope_guard warnings_are { - my $factory = DBICTest->init_schema (AutoCommit => 0); + my $factory = DBICTest->init_schema; cmp_ok ($factory->resultset('CD')->count, '>', 0, 'Something to delete'); my $dbh = $factory->storage->dbh; + $dbh->{AutoCommit} = 0; ok (!$dbh->{AutoCommit}, 'AutoCommit is off on $dbh'); my $schema = DBICTest::Schema->connect (sub { $dbh }); @@ -379,14 +399,14 @@ warnings_are { # make sure AutoCommit => 0 on external handles behaves correctly with txn_do warnings_are { - my $factory = DBICTest->init_schema (AutoCommit => 0); + my $factory = DBICTest->init_schema; cmp_ok ($factory->resultset('CD')->count, '>', 0, 'Something to delete'); my $dbh = $factory->storage->dbh; + $dbh->{AutoCommit} = 0; ok (!$dbh->{AutoCommit}, 'AutoCommit is off on $dbh'); my $schema = DBICTest::Schema->connect (sub { $dbh }); - lives_ok ( sub { $schema->txn_do (sub { $schema->resultset ('CD')->delete }); }, 'No attempt to start a atransaction with txn_do'); @@ -398,4 +418,52 @@ warnings_are { } [], 'No warnings on AutoCommit => 0 with txn_do'; + +# make sure we are not fucking up the stacktrace on broken overloads +{ + package DBICTest::BrokenOverload; + + use overload '""' => sub { $_[0] }; +} + +{ + my @w; + local $SIG{__WARN__} = sub { + $_[0] =~ /\QExternal exception class DBICTest::BrokenOverload implements partial (broken) overloading preventing its instances from being used in simple (\E\$x eq \$y\Q) comparisons/ + ? push @w, @_ + : warn @_ + }; + + my $s = DBICTest->init_schema(no_deploy => 1); + $s->stacktrace(0); + my $g = $s->storage->txn_scope_guard; + my $broken_exception = bless {}, 'DBICTest::BrokenOverload'; + + # FIXME - investigate what confuses the regex engine below + + # do not reformat - line-num part of the test + my $ln = __LINE__ + 6; + throws_ok { + $s->txn_do( sub { + $s->txn_do( sub { + $s->storage->_dbh->disconnect; + die $broken_exception + }); + }) + } qr/\QTransaction aborted: $broken_exception. Rollback failed: lost connection to storage at @{[__FILE__]} line $ln\E\n/; # FIXME wtf - ...\E$/m doesn't work here + + is @w, 1, 'One matching warning only'; + + # try the same broken exception object, but have exception_action inject it + $s->exception_action(sub { die $broken_exception }); + eval { + $s->txn_do( sub { + die "some string masked away"; + }); + }; + isa_ok $@, 'DBICTest::BrokenOverload', 'Deficient exception properly propagated'; + + is @w, 2, 'The warning was emitted a second time'; +} + done_testing;