Revision history for DBIx::Class
+ * Fixes
+ - More robust behavior under heavily threaded environments - make
+ sure we do not have refaddr reuse in the global storage registry
+
0.08204 2012-11-08
* New Features / Changes
- SQLMaker now accepts \'literal' with the 'for' rs attribute as an
my %seek_and_destroy;
sub _arm_global_destructor {
- my $self = shift;
- my $key = refaddr ($self);
- $seek_and_destroy{$key} = $self;
- weaken ($seek_and_destroy{$key});
+ weaken (
+ $seek_and_destroy{ refaddr($_[0]) } = $_[0]
+ );
}
END {
# As per DBI's recommendation, DBIC disconnects all handles as
# soon as possible (DBIC will reconnect only on demand from within
# the thread)
- for (values %seek_and_destroy) {
- next unless $_;
+ my @instances = grep { defined $_ } values %seek_and_destroy;
+ for (@instances) {
$_->{_dbh_gen}++; # so that existing cursors will drop as well
$_->_dbh(undef);
$_->transaction_depth(0);
$_->savepoints([]);
}
+
+ # properly renumber all existing refs
+ %seek_and_destroy = ();
+ $_->_arm_global_destructor for @instances;
}
}
use lib qw(t/lib);
use DBICTest::RunMode;
-use DBICTest::Util qw/populate_weakregistry assert_empty_weakregistry/;
+use DBICTest::Util::LeakTracer qw/populate_weakregistry assert_empty_weakregistry/;
+use Scalar::Util 'refaddr';
use DBIx::Class;
use B 'svref_2object';
BEGIN {
leaky_resultset => $rs_bind_circref,
leaky_resultset_cond => $cond_rowobj,
- leaky_resultset_member => $rs_bind_circref->next,
};
+ # this needs to fire, even if it can't find anything
+ # see FIXME below
+ $rs_bind_circref->next;
+
require Storable;
%$base_collection = (
%$base_collection,
use warnings;
use DBICTest::RunMode;
use DBICTest::Schema;
-use DBICTest::Util qw/populate_weakregistry assert_empty_weakregistry local_umask/;
+use DBICTest::Util::LeakTracer qw/populate_weakregistry assert_empty_weakregistry/;
+use DBICTest::Util 'local_umask';
use Carp;
use Path::Class::File ();
use File::Spec;
use Fcntl qw/:DEFAULT :seek :flock/;
use Time::HiRes 'sleep';
use DBICTest::RunMode;
-use DBICTest::Util qw/populate_weakregistry assert_empty_weakregistry local_umask/;
+use DBICTest::Util::LeakTracer qw/populate_weakregistry assert_empty_weakregistry/;
+use DBICTest::Util 'local_umask';
use namespace::clean;
__PACKAGE__->mk_group_accessors(simple => 'custom_attr');
use strict;
use Carp;
-use Scalar::Util qw/isweak weaken blessed reftype refaddr/;
use Config;
use base 'Exporter';
-our @EXPORT_OK = qw/local_umask stacktrace populate_weakregistry assert_empty_weakregistry/;
+our @EXPORT_OK = qw/local_umask stacktrace/;
sub local_umask {
return unless defined $Config{d_umask};
return join "\tinvoked as ", map { sprintf ("%s at %s line %d\n", @$_ ) } @stack;
}
-my $refs_traced = 0;
-sub populate_weakregistry {
- my ($reg, $target, $slot) = @_;
-
- croak 'Target is not a reference' unless defined ref $target;
-
- $slot ||= (sprintf '%s%s(0x%x)', # so we don't trigger stringification
- (defined blessed $target) ? blessed($target) . '=' : '',
- reftype $target,
- refaddr $target,
- );
-
- if (defined $reg->{$slot}{weakref}) {
- if ( refaddr($reg->{$slot}{weakref}) != (refaddr $target) ) {
- print STDERR "Bail out! Weak Registry slot collision: $reg->{$slot}{weakref} / $target\n";
- exit 255;
- }
- }
- else {
- $refs_traced++;
- weaken( $reg->{$slot}{weakref} = $target );
- $reg->{$slot}{stacktrace} = stacktrace(1);
- }
-
- $target;
-}
-
-my $leaks_found;
-sub assert_empty_weakregistry {
- my ($weak_registry, $quiet) = @_;
-
- croak 'Expecting a registry hashref' unless ref $weak_registry eq 'HASH';
-
- return unless keys %$weak_registry;
-
- my $tb = eval { Test::Builder->new }
- or croak 'Calling test_weakregistry without a loaded Test::Builder makes no sense';
-
- for my $slot (sort keys %$weak_registry) {
- next if ! defined $weak_registry->{$slot}{weakref};
- $tb->BAILOUT("!!!! WEAK REGISTRY SLOT $slot IS NOT A WEAKREF !!!!")
- unless isweak( $weak_registry->{$slot}{weakref} );
- }
-
-
- for my $slot (sort keys %$weak_registry) {
- ! defined $weak_registry->{$slot}{weakref} and next if $quiet;
-
- $tb->ok (! defined $weak_registry->{$slot}{weakref}, "No leaks of $slot") or do {
- $leaks_found = 1;
-
- 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}{stacktrace}) {
- $diag .= " Reference first seen$stack";
- }
-
- $tb->diag($diag) if $diag;
- };
- }
-}
-
-END {
- if ($INC{'Test/Builder.pm'}) {
- my $tb = Test::Builder->new;
-
- # we check for test passage - a leak may be a part of a TODO
- if ($leaks_found and !$tb->is_passing) {
-
- $tb->diag(sprintf
- "\n\n%s\n%s\n\nInstall Devel::FindRef and re-run the test with set "
- . '$ENV{TEST_VERBOSE} (prove -v) to see a more detailed leak-report'
- . "\n\n%s\n%s\n\n", ('#' x 16) x 4
- ) if ( !$ENV{TEST_VERBOSE} or !$INC{'Devel/FindRef.pm'} );
-
- }
- else {
- $tb->note("Auto checked $refs_traced references for leaks - none detected");
- }
- }
-}
-
1;
--- /dev/null
+package DBICTest::Util::LeakTracer;
+
+use warnings;
+use strict;
+
+use Carp;
+use Scalar::Util qw/isweak weaken blessed reftype refaddr/;
+use DBICTest::Util 'stacktrace';
+
+use base 'Exporter';
+our @EXPORT_OK = qw/populate_weakregistry assert_empty_weakregistry/;
+
+my $refs_traced = 0;
+my $leaks_found;
+my %reg_of_regs;
+
+sub populate_weakregistry {
+ my ($weak_registry, $target, $slot) = @_;
+
+ croak 'Expecting a registry hashref' unless ref $weak_registry eq 'HASH';
+ croak 'Target is not a reference' unless length ref $target;
+
+ $slot ||= (sprintf '%s%s(0x%x)', # so we don't trigger stringification
+ (defined blessed $target) ? blessed($target) . '=' : '',
+ reftype $target,
+ refaddr $target,
+ );
+
+ if (defined $weak_registry->{$slot}{weakref}) {
+ if ( refaddr($weak_registry->{$slot}{weakref}) != (refaddr $target) ) {
+ print STDERR "Bail out! Weak Registry slot collision: $weak_registry->{$slot}{weakref} / $target\n";
+ exit 255;
+ }
+ }
+ else {
+ $refs_traced++;
+ weaken( $weak_registry->{$slot}{weakref} = $target );
+ $weak_registry->{$slot}{stacktrace} = stacktrace(1);
+ $weak_registry->{$slot}{renumber} = 1 unless $_[2];
+ }
+
+ weaken( $reg_of_regs{ refaddr($weak_registry) } = $weak_registry )
+ unless( $reg_of_regs{ refaddr($weak_registry) } );
+
+ $target;
+}
+
+# Renumber everything we auto-named on a thread spawn
+sub CLONE {
+ my @individual_regs = grep { scalar keys %{$_||{}} } values %reg_of_regs;
+ %reg_of_regs = ();
+
+ for my $reg (@individual_regs) {
+ my @live_slots = grep { defined $reg->{$_}{weakref} } keys %$reg
+ or next;
+ my @live_instances = @{$reg}{@live_slots};
+
+ %$reg = ();
+ weaken( $reg_of_regs{refaddr($reg)} = $reg );
+
+ while (@live_slots) {
+ my $slot = shift @live_slots;
+ my $inst = shift @live_instances;
+
+ $slot =~ s/0x[0-9A-F]+/'0x' . sprintf ('0x%x', refaddr($inst))/ieg
+ if $inst->{renumber};
+
+ $reg->{$slot} = $inst;
+ }
+ }
+}
+
+sub assert_empty_weakregistry {
+ my ($weak_registry, $quiet) = @_;
+
+ croak 'Expecting a registry hashref' unless ref $weak_registry eq 'HASH';
+
+ return unless keys %$weak_registry;
+
+ my $tb = eval { Test::Builder->new }
+ or croak 'Calling test_weakregistry without a loaded Test::Builder makes no sense';
+
+ for my $slot (sort keys %$weak_registry) {
+ next if ! defined $weak_registry->{$slot}{weakref};
+ $tb->BAILOUT("!!!! WEAK REGISTRY SLOT $slot IS NOT A WEAKREF !!!!")
+ unless isweak( $weak_registry->{$slot}{weakref} );
+ }
+
+
+ for my $slot (sort keys %$weak_registry) {
+ ! defined $weak_registry->{$slot}{weakref} and next if $quiet;
+
+ $tb->ok (! defined $weak_registry->{$slot}{weakref}, "No leaks of $slot") or do {
+ $leaks_found = 1;
+
+ 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}{stacktrace}) {
+ $diag .= " Reference first seen$stack";
+ }
+
+ $tb->diag($diag) if $diag;
+ };
+ }
+}
+
+END {
+ if ($INC{'Test/Builder.pm'}) {
+ my $tb = Test::Builder->new;
+
+ # we check for test passage - a leak may be a part of a TODO
+ if ($leaks_found and !$tb->is_passing) {
+
+ $tb->diag(sprintf
+ "\n\n%s\n%s\n\nInstall Devel::FindRef and re-run the test with set "
+ . '$ENV{TEST_VERBOSE} (prove -v) to see a more detailed leak-report'
+ . "\n\n%s\n%s\n\n", ('#' x 16) x 4
+ ) if ( !$ENV{TEST_VERBOSE} or !$INC{'Devel/FindRef.pm'} );
+
+ }
+ else {
+ $tb->note("Auto checked $refs_traced references for leaks - none detected");
+ }
+ }
+}
+
+1;
projects / dbsrgits/DBIx-Class.git / commitdiff