From: Peter Rabbitson Date: Tue, 14 Jan 2014 15:19:26 +0000 (+0100) Subject: Stop various CLONE-registries from growing indefinitely X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=85ad63df4eaa9b308b9ca5a3cd1aa20b9f730312;p=dbsrgits%2FDBIx-Class-Historic.git Stop various CLONE-registries from growing indefinitely --- diff --git a/lib/DBIx/Class/Storage/DBI.pm b/lib/DBIx/Class/Storage/DBI.pm index f45a612..9e340f0 100644 --- a/lib/DBIx/Class/Storage/DBI.pm +++ b/lib/DBIx/Class/Storage/DBI.pm @@ -205,6 +205,12 @@ sub new { my %seek_and_destroy; sub _arm_global_destructor { + + # quick "garbage collection" pass - prevents the registry + # from slowly growing with a bunch of undef-valued keys + defined $seek_and_destroy{$_} or delete $seek_and_destroy{$_} + for keys %seek_and_destroy; + weaken ( $seek_and_destroy{ refaddr($_[0]) } = $_[0] ); diff --git a/lib/DBIx/Class/Storage/DBI/Cursor.pm b/lib/DBIx/Class/Storage/DBI/Cursor.pm index a8f087d..6681d23 100644 --- a/lib/DBIx/Class/Storage/DBI/Cursor.pm +++ b/lib/DBIx/Class/Storage/DBI/Cursor.pm @@ -59,8 +59,15 @@ Returns a new L object. attrs => $attrs, }, ref $class || $class; - weaken( $cursor_registry{ refaddr($self) } = $self ) - if DBIx::Class::_ENV_::HAS_ITHREADS; + if (DBIx::Class::_ENV_::HAS_ITHREADS) { + + # quick "garbage collection" pass - prevents the registry + # from slowly growing with a bunch of undef-valued keys + defined $cursor_registry{$_} or delete $cursor_registry{$_} + for keys %cursor_registry; + + weaken( $cursor_registry{ refaddr($self) } = $self ) + } return $self; } diff --git a/t/lib/DBICTest/Util/LeakTracer.pm b/t/lib/DBICTest/Util/LeakTracer.pm index 5c91afe..10dca61 100644 --- a/t/lib/DBICTest/Util/LeakTracer.pm +++ b/t/lib/DBICTest/Util/LeakTracer.pm @@ -38,6 +38,17 @@ sub populate_weakregistry { # a registry could be fed to itself or another registry via recursive sweeps return $target if $reg_of_regs{$refaddr}; + weaken( $reg_of_regs{ hrefaddr($weak_registry) } = $weak_registry ) + unless( $reg_of_regs{ hrefaddr($weak_registry) } ); + + # an explicit "garbage collection" pass every time we store a ref + # if we do not do this the registry will keep growing appearing + # as if the traced program is continuously slowly leaking memory + for my $reg (values %reg_of_regs) { + (defined $reg->{$_}{weakref}) or delete $reg->{$_} + for keys %$reg; + } + if (! defined $weak_registry->{$refaddr}{weakref}) { $weak_registry->{$refaddr} = { stacktrace => stacktrace(1), @@ -54,9 +65,6 @@ sub populate_weakregistry { $weak_registry->{$refaddr}{slot_names}{$note} = 1; } - weaken( $reg_of_regs{ hrefaddr($weak_registry) } = $weak_registry ) - unless( $reg_of_regs{ hrefaddr($weak_registry) } ); - $target; }