From: Peter Rabbitson Date: Wed, 14 Nov 2012 08:54:18 +0000 (+0100) Subject: More robust behavior under heavily threaded environments X-Git-Tag: v0.08205~109 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=218b7c12;p=dbsrgits%2FDBIx-Class.git More robust behavior under heavily threaded environments --- diff --git a/Changes b/Changes index 14052063..88feed4 100644 --- a/Changes +++ b/Changes @@ -1,5 +1,9 @@ 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 diff --git a/lib/DBIx/Class/Storage/DBI.pm b/lib/DBIx/Class/Storage/DBI.pm index 6825e15..3af0805 100644 --- a/lib/DBIx/Class/Storage/DBI.pm +++ b/lib/DBIx/Class/Storage/DBI.pm @@ -198,10 +198,9 @@ sub new { 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 { @@ -218,14 +217,18 @@ sub new { # 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; } } diff --git a/t/52leaks.t b/t/52leaks.t index eb72a82..da99c8b 100644 --- a/t/52leaks.t +++ b/t/52leaks.t @@ -47,7 +47,8 @@ if ($ENV{DBICTEST_IN_PERSISTENT_ENV}) { 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 { @@ -257,9 +258,12 @@ my @compose_ns_classes; 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, diff --git a/t/lib/DBICTest.pm b/t/lib/DBICTest.pm index c330d67..0c1d3b2 100644 --- a/t/lib/DBICTest.pm +++ b/t/lib/DBICTest.pm @@ -5,7 +5,8 @@ use strict; 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; diff --git a/t/lib/DBICTest/Schema.pm b/t/lib/DBICTest/Schema.pm index d2d41d0..8abb593 100644 --- a/t/lib/DBICTest/Schema.pm +++ b/t/lib/DBICTest/Schema.pm @@ -10,7 +10,8 @@ use base 'DBICTest::BaseSchema'; 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'); diff --git a/t/lib/DBICTest/Util.pm b/t/lib/DBICTest/Util.pm index 3f489c2..557ee36 100644 --- a/t/lib/DBICTest/Util.pm +++ b/t/lib/DBICTest/Util.pm @@ -4,11 +4,10 @@ use warnings; 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}; @@ -47,89 +46,4 @@ sub stacktrace { 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; diff --git a/t/lib/DBICTest/Util/LeakTracer.pm b/t/lib/DBICTest/Util/LeakTracer.pm new file mode 100644 index 0000000..1720f8c --- /dev/null +++ b/t/lib/DBICTest/Util/LeakTracer.pm @@ -0,0 +1,130 @@ +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;