diff --git a/lib/Template/Grammar.pm b/lib/Template/Grammar.pm index 845e05e4..81c6550e 100644 --- a/lib/Template/Grammar.pm +++ b/lib/Template/Grammar.pm @@ -123,69 +123,9 @@ sub new { }, $class; } -# track usages of objects using the factory -# this is used to track how many objects are currently using the shared factory -# so we can safely clear it when the last user is destroyed -my $factory_usages; - -sub DESTROY { - my ( $self ) = @_; - - # on Grammar destruction check if we can safely trigger the destroy for the factory - $self->unregister_factory() if $self; - - return; -} - -sub unregister_factory { - my ( $self ) = @_; - - return unless $self && defined $factory && ref $factory_usages; - return unless "$factory" eq $factory_usages->{CURRENT}; - - if ( $factory_usages->{HOLD_BY}->{ "$self" } ) { - delete $factory_usages->{HOLD_BY}->{ "$self" }; - } - - if ( ! scalar keys %{ $factory_usages->{HOLD_BY} } ) { - # avoid a memory leak from factory - undef $factory; - undef $factory_usages; - } - - return; -} - -sub register_factory { - my ( $self ) = @_; - - return unless $factory; - - $factory_usages //= { CURRENT => "", HOLD_BY => {} }; - - if ( "$factory" ne $factory_usages->{CURRENT} ) { - # we have updated the factory, should not care about the previous one... - $factory_usages->{HOLD_BY} = {}; # reset who hold the factory - $factory_usages->{CURRENT} = "$factory"; # stringify it - } - - $factory_usages->{HOLD_BY}->{ "$self" } = 1; # we are using this factory - - return; -} - -# update method to set package-scoped $factory lexical -# note: only objects that call install_factory() are tracked for cleanup; -# objects created via new() without installing a factory are not tracked -# (this is intentional — only factory installers own the reference) sub install_factory { my ($self, $new_factory) = @_; - $factory = $new_factory; - - # register the current factory in order to clean it on destroy if possible - $self->register_factory(); - return $factory; } diff --git a/lib/Template/Provider.pm b/lib/Template/Provider.pm index 52a59768..936176e0 100644 --- a/lib/Template/Provider.pm +++ b/lib/Template/Provider.pm @@ -337,7 +337,7 @@ sub _init { $dlim //= MSWin32 ? qr/:(?!\\|\/)/ : qr/:/; # coerce INCLUDE_PATH to an array ref, if not already so - $path = [ split(/$dlim/, $path) ] + $path = [ split($dlim, $path) ] unless ref $path eq 'ARRAY'; # don't allow a CACHE_SIZE 1 because it breaks things and the diff --git a/lib/Template/Stash.pm b/lib/Template/Stash.pm index 494f0ef1..1290dc64 100644 --- a/lib/Template/Stash.pm +++ b/lib/Template/Stash.pm @@ -443,7 +443,7 @@ sub _dotop { return undef unless defined($root) and defined($item); # or if an attempt is made to access a private member, starting _ or . - return undef if $PRIVATE && $item =~ /$PRIVATE/; + return undef if $PRIVATE && $item =~ $PRIVATE; if ($atroot || $rootref eq 'HASH') { # if $root is a regular HASH or a Template::Stash kinda HASH (the @@ -607,7 +607,7 @@ sub _assign { return undef unless $root and defined $item; # or if an attempt is made to update a private member, starting _ or . - return undef if $PRIVATE && $item =~ /$PRIVATE/; + return undef if $PRIVATE && $item =~ $PRIVATE; if ($rootref eq 'HASH' || $atroot) { # if the root is a hash we set the named key diff --git a/lib/Template/VMethods.pm b/lib/Template/VMethods.pm index 1a322824..1bec23c2 100644 --- a/lib/Template/VMethods.pm +++ b/lib/Template/VMethods.pm @@ -379,7 +379,7 @@ sub text_dquote { sub hash_item { my ($hash, $item) = @_; $item //= ''; - return if $PRIVATE && $item =~ /$PRIVATE/; + return if $PRIVATE && $item =~ $PRIVATE; $hash->{ $item }; } diff --git a/t/zz-grammar-factory-leak.t b/t/zz-grammar-factory-leak.t index de9c214c..29f40204 100644 --- a/t/zz-grammar-factory-leak.t +++ b/t/zz-grammar-factory-leak.t @@ -79,10 +79,13 @@ my $vars_with_stuff = { }; { - # First call may allocate the grammar singleton -- run once to warm up + # Warm up: exercise all code paths so that one-time regex compilations + # and singleton allocations don't appear as leaks on older Perls. my $tt_warmup = Template->new(); my $warmup_out = ''; $tt_warmup->process( \$template_text, $vars_simple, \$warmup_out ); + $warmup_out = ''; + $tt_warmup->process( \$template_text, $vars_with_stuff, \$warmup_out ); } # The second process call should not leak @@ -132,7 +135,7 @@ no_leaks_ok { } "no leak when creating and destroying Template objects in a loop"; # ----------------------------------------------------------------------- -# Test 7: Factory is properly shared and cleaned +# Test 7: Factory is a persistent singleton shared across Grammar objects # ----------------------------------------------------------------------- { @@ -144,11 +147,8 @@ no_leaks_ok { $g2->install_factory($factory1); undef $g1; - # factory should still be alive because g2 holds it - pass("partial Grammar destruction does not crash"); - undef $g2; - # now factory should be cleaned up + pass("Grammar destruction with shared factory does not crash"); } # ----------------------------------------------------------------------- diff --git a/t/zz-process-leak.t b/t/zz-process-leak.t index 58da4971..4ecb5772 100644 --- a/t/zz-process-leak.t +++ b/t/zz-process-leak.t @@ -33,6 +33,25 @@ plan( tests => 6 ); note "Searching for leak using Test::LeakTrace..."; +# Warm up: exercise all code paths once so that one-time regex +# compilations and singleton allocations don't appear as leaks +# on older Perls where qr// interpolation caches REGEXP SVs. +{ + my $warmup_text = <<'EOT'; +[% FOREACH item IN data -%] +[% item.val %] +[% FOREACH data IN item.stuff -%] +... one item +[% END -%] +[% END -%] +EOT + my $warmup_out = ''; + my $tt = Template->new(); + $tt->process(\$warmup_text, { + data => [ { val => 'x', stuff => [ { name => 'y' } ] } ] + }, \$warmup_out); +} + my $vars1 = { data => [ {