Permalink
Browse files

Test suite wide leaktesting

  • Loading branch information...
1 parent 9345b14 commit 65d351219882184861384aedac6f251b6797d0d7 @ribasushi ribasushi committed Feb 14, 2012
View
@@ -26,6 +26,8 @@ Revision history for DBIx::Class
when the position column is part of a unique constraint
* Misc
+ - Centralized leak-checks for all instances of DBICTest::Schema
+ from within any test
- Codebase is now trailing-whitespace-free
- Cleanup of complex resultset update/delete oprations - storage
specific code moved back to ResultSet and replaced by checks
View
@@ -14,12 +14,11 @@ my $schema = DBICTest->init_schema;
# which might need updating at some future time to be some other
# exception-generating statement:
-sub throwex { $schema->resultset("Artist")->search(1,1,1); }
+my $throw = sub { $schema->resultset("Artist")->search(1,1,1) };
my $ex_regex = qr/Odd number of arguments to search/;
# Basic check, normal exception
-throws_ok { throwex }
- $ex_regex;
+throws_ok \&$throw, $ex_regex;
my $e = $@;
@@ -30,27 +29,26 @@ isa_ok( $@, 'DBIx::Class::Exception' );
# Now lets rethrow via exception_action
$schema->exception_action(sub { die @_ });
-throws_ok { throwex }
- $ex_regex;
+throws_ok \&$throw, $ex_regex;
#
# This should have never worked!!!
#
# Now lets suppress the error
$schema->exception_action(sub { 1 });
-throws_ok { throwex }
+throws_ok \&$throw,
qr/exception_action handler .+ did \*not\* result in an exception.+original error: $ex_regex/;
# Now lets fall through and let croak take back over
$schema->exception_action(sub { return });
throws_ok {
- warnings_are { throwex }
+ warnings_are \&$throw,
qr/exception_action handler installed .+ returned false instead throwing an exception/;
} $ex_regex;
# again to see if no warning
throws_ok {
- warnings_are { throwex }
+ warnings_are \&$throw,
[];
} $ex_regex;
@@ -75,7 +73,7 @@ throws_ok {
# Try the exception class
$schema->exception_action(sub { DBICTest::Exception->throw(@_) });
-throws_ok { throwex }
+throws_ok \&$throw,
qr/DBICTest::Exception is handling this: $ex_regex/;
# While we're at it, lets throw a custom exception through Storage::DBI
View
@@ -16,4 +16,15 @@ warnings_exist { DBICTest->init_schema( compose_connection => 1, sqlite_use_file
cmp_ok(DBICTest->resultset('Artist')->count, '>', 0, 'count is valid');
+# cleanup globals so we do not trigger the leaktest
+for ( map { DBICTest->schema->class($_) } DBICTest->schema->sources ) {
+ $_->class_resolver(undef);
+ $_->resultset_instance(undef);
+ $_->result_source_instance(undef);
+}
+{
+ no warnings qw/redefine once/;
+ *DBICTest::schema = sub {};
+}
+
done_testing;
View
@@ -35,15 +35,14 @@ if ($ENV{DBICTEST_IN_PERSISTENT_ENV}) {
use lib qw(t/lib);
use DBICTest::RunMode;
+use DBICTest::Util qw/populate_weakregistry assert_empty_weakregistry/;
use DBIx::Class;
use B 'svref_2object';
BEGIN {
plan skip_all => "Your perl version $] appears to leak like a sieve - skipping test"
if DBIx::Class::_ENV_::PEEPEENESS;
}
-use Scalar::Util qw/refaddr reftype weaken/;
-
# this is what holds all weakened refs to be checked for leakage
my $weak_registry = {};
@@ -53,19 +52,6 @@ my $has_dt;
# Skip the heavy-duty leak tracing when just doing an install
unless (DBICTest::RunMode->is_plain) {
- # have our own little stack maker - Carp infloops due to the bless override
- my $trace = sub {
- my $depth = 1;
- my (@stack, @frame);
-
- while (@frame = caller($depth++)) {
- push @stack, [@frame[3,1,2]];
- }
-
- $stack[0][0] = '';
- return join "\tinvoked as ", map { sprintf ("%s at %s line %d\n", @$_ ) } @stack;
- };
-
# redefine the bless override so that we can catch each and every object created
no warnings qw/redefine once/;
no strict qw/refs/;
@@ -81,29 +67,15 @@ unless (DBICTest::RunMode->is_plain) {
}
);
- my $slot = (sprintf '%s=%s(0x%x)', # so we don't trigger stringification
- ref $obj,
- reftype $obj,
- refaddr $obj,
- );
-
# weaken immediately to avoid weird side effects
- $weak_registry->{$slot} = { weakref => $obj, strace => $trace->() };
- weaken $weak_registry->{$slot}{weakref};
-
- return $obj;
+ return populate_weakregistry ($weak_registry, $obj );
};
require Try::Tiny;
for my $func (qw/try catch finally/) {
my $orig = \&{"Try::Tiny::$func"};
*{"Try::Tiny::$func"} = sub (&;@) {
-
- my $slot = sprintf ('CODE(0x%x)', refaddr $_[0]);
-
- $weak_registry->{$slot} = { weakref => $_[0], strace => $trace->() };
- weaken $weak_registry->{$slot}{weakref};
-
+ populate_weakregistry( $weak_registry, $_[0] );
goto $orig;
}
}
@@ -309,10 +281,8 @@ my @compose_ns_classes;
}
}
- for (keys %$base_collection) {
- $weak_registry->{"basic $_"} = { weakref => $base_collection->{$_} };
- weaken $weak_registry->{"basic $_"}{weakref};
- }
+ populate_weakregistry ($weak_registry, $base_collection->{$_}, "basic $_")
+ for keys %$base_collection;
}
# check that "phantom-chaining" works - we never lose track of the original $schema
@@ -344,16 +314,7 @@ my @compose_ns_classes;
sub { shift->delete },
sub { shift->insert },
) {
- $phantom = $_->($phantom);
-
- my $slot = (sprintf 'phantom %s=%s(0x%x)', # so we don't trigger stringification
- ref $phantom,
- reftype $phantom,
- refaddr $phantom,
- );
-
- $weak_registry->{$slot} = $phantom;
- weaken $weak_registry->{$slot};
+ $phantom = populate_weakregistry ( $weak_registry, scalar $_->($phantom) );
}
ok( $phantom->in_storage, 'Properly deleted/reinserted' );
@@ -433,21 +394,7 @@ TODO: {
or $r->result_source(undef);
}
-for my $slot (sort keys %$weak_registry) {
-
- ok (! defined $weak_registry->{$slot}{weakref}, "No leaks of $slot") or do {
- my $diag = '';
-
- $diag .= Devel::FindRef::track ($weak_registry->{$slot}{weakref}, 20) . "\n"
- if ( $ENV{TEST_VERBOSE} && eval { require Devel::FindRef });
-
- if (my $stack = $weak_registry->{$slot}{strace}) {
- $diag .= " Reference first seen$stack";
- }
-
- diag $diag if $diag;
- };
-}
+assert_empty_weakregistry ($weak_registry);
# we got so far without a failure - this is a good thing
# now let's try to rerun this script under a "persistent" environment
View
@@ -449,7 +449,8 @@ done_testing;
END {
return unless $schema;
drop_test_schema($schema);
- eapk_drop_all( $schema)
+ eapk_drop_all($schema);
+ undef $schema;
};
View
@@ -557,13 +557,15 @@ sub do_creates {
# clean up our mess
END {
- eval {
- my $dbh = $schema->storage->dbh;
- $dbh->do("DROP SEQUENCE artist_pk_seq");
- $dbh->do("DROP SEQUENCE cd_seq");
- $dbh->do("DROP SEQUENCE track_seq");
- $dbh->do("DROP TABLE artist");
- $dbh->do("DROP TABLE track");
- $dbh->do("DROP TABLE cd");
+ if ($schema and my $dbh = $schema->storage->dbh) {
+ eval { $dbh->do($_) } for (
+ 'DROP SEQUENCE artist_pk_seq',
+ 'DROP SEQUENCE cd_seq',
+ 'DROP SEQUENCE track_seq',
+ 'DROP TABLE artist',
+ 'DROP TABLE track',
+ 'DROP TABLE cd',
+ );
};
+ undef $schema;
}
View
@@ -158,6 +158,7 @@ done_testing;
# clean up our mess
END {
- my $dbh = eval { $schema->storage->_dbh };
- $dbh->do("DROP TABLE artist") if $dbh;
+ my $dbh = eval { $schema->storage->_dbh };
+ $dbh->do("DROP TABLE artist") if $dbh;
+ undef $schema;
}
View
@@ -86,6 +86,7 @@ is_deeply($type_info, $test_type_info, 'columns_info_for - column data types');
# clean up our mess
END {
- my $dbh = eval { $schema->storage->_dbh };
- $dbh->do("DROP TABLE artist") if $dbh;
+ my $dbh = eval { $schema->storage->_dbh };
+ $dbh->do("DROP TABLE artist") if $dbh;
+ undef $schema;
}
View
@@ -580,5 +580,6 @@ END {
eval { $dbh->do("DROP TABLE $_") }
for qw/artist artist_guid money_test books owners/;
}
+ undef $schema;
}
# vim:sw=2 sts=2
View
@@ -638,4 +638,6 @@ END {
eval { $dbh->do("DROP TABLE $_") }
for qw/artist bindtype_test money_test computed_column_test/;
}
+
+ undef $schema;
}
View
@@ -93,5 +93,7 @@ END {
eval { $dbh->do("DROP TABLE $_") }
for qw/artist/;
}
+
+ undef $schema;
}
# vim:sw=2 sts=2
View
@@ -145,6 +145,7 @@ done_testing;
# clean up our mess
END {
- my $dbh = eval { $schema->storage->_dbh };
- $dbh->do("DROP TABLE artist") if $dbh;
+ my $dbh = eval { $schema->storage->_dbh };
+ $dbh->do("DROP TABLE artist") if $dbh;
+ undef $schema;
}
View
@@ -48,7 +48,7 @@ foreach my $info (@info) {
auto_savepoint => 1
});
- my $guard = Scope::Guard->new(\&cleanup);
+ my $guard = Scope::Guard->new(sub{ cleanup($schema) });
my $dbh = $schema->storage->dbh;
@@ -259,6 +259,7 @@ SQL
done_testing;
sub cleanup {
+ my $schema = shift;
eval { $schema->storage->dbh->do("DROP TABLE $_") }
for qw/artist artist_guid bindtype_test/;
}
View
@@ -10,6 +10,7 @@ BEGIN {
use Test::More;
use Test::Exception;
+use Scalar::Util 'weaken';
use DBIx::Class::Optional::Dependencies ();
use lib qw(t/lib);
use DBICTest;
@@ -123,7 +124,8 @@ for my $storage_type (@test_storages) {
SQL
});
- my $rs = $schema->resultset('Money');
+ my $rs = $schema->resultset('Money');
+ weaken(my $rs_cp = $rs); # nested closure refcounting is an utter mess in perl
my $row;
lives_ok {
@@ -151,7 +153,7 @@ SQL
# test simple transaction with commit
lives_ok {
$schema->txn_do(sub {
- $rs->create({ amount => 300 });
+ $rs_cp->create({ amount => 300 });
});
} 'simple transaction';
@@ -163,7 +165,7 @@ SQL
# test rollback
throws_ok {
$schema->txn_do(sub {
- $rs->create({ amount => 700 });
+ $rs_cp->create({ amount => 700 });
die 'mtfnpy';
});
} qr/mtfnpy/, 'simple failed txn';
@@ -212,9 +214,10 @@ SQL
# a reconnect should trigger on next action
$schema->storage->_get_dbh->disconnect;
+
lives_and {
$wrappers->{$wrapper}->( sub {
- $rs->create({ amount => 900 + $_ }) for 1..3;
+ $rs_cp->create({ amount => 900 + $_ }) for 1..3;
});
is $rs->count, 3;
} "transaction on disconnected handle with $wrapper wrapper";
@@ -245,12 +248,13 @@ SQL
my $map = [ ['Artist 1', '1002.00'], ['Artist 2', '1003.00'] ];
+ weaken(my $a_rs_cp = $artist_rs);
+
lives_and {
my @results;
-
$wrappers->{$wrapper}->( sub {
- while (my $money = $rs->next) {
- my $artist = $artist_rs->next;
+ while (my $money = $rs_cp->next) {
+ my $artist = $a_rs_cp->next;
push @results, [ $artist->name, $money->amount ];
};
});
@@ -332,4 +336,6 @@ END {
$dbh->do("IF OBJECT_ID('cd', 'U') IS NOT NULL DROP TABLE cd");
$dbh->do("IF OBJECT_ID('money_test', 'U') IS NOT NULL DROP TABLE money_test");
}
+
+ undef $schema;
}
View
@@ -52,7 +52,7 @@ for my $prefix (keys %$env2optdep) { SKIP: {
});
my $dbh = $schema->storage->dbh;
- my $sg = Scope::Guard->new(\&cleanup);
+ my $sg = Scope::Guard->new(sub { cleanup($schema) });
eval { $dbh->do(q[DROP TABLE "artist"]) };
$dbh->do(<<EOF);
@@ -305,6 +305,8 @@ done_testing;
# clean up our mess
sub cleanup {
+ my $schema = shift;
+
my $dbh;
eval {
$schema->storage->disconnect; # to avoid object FOO is in use errors
Oops, something went wrong.

0 comments on commit 65d3512

Please sign in to comment.