diff options
author | Jesse Luehrs <doy@tozt.net> | 2012-03-30 12:22:10 -0500 |
---|---|---|
committer | Jesse Luehrs <doy@tozt.net> | 2012-03-30 12:22:10 -0500 |
commit | 7162530659a43889d67252553d53806916e6a7f2 (patch) | |
tree | 6eb0079c86be7c17897b506d96668810fcb9adc8 /lib/Eval | |
parent | 21665b5f20fc7c96f4819bc1b754980e77849c05 (diff) | |
download | eval-closure-7162530659a43889d67252553d53806916e6a7f2.tar.gz eval-closure-7162530659a43889d67252553d53806916e6a7f2.zip |
delete packages when we're done with them, to avoid leakingfix-memory-leaks
Diffstat (limited to 'lib/Eval')
-rw-r--r-- | lib/Eval/Closure.pm | 31 |
1 files changed, 24 insertions, 7 deletions
diff --git a/lib/Eval/Closure.pm b/lib/Eval/Closure.pm index 46a3448..5313ff8 100644 --- a/lib/Eval/Closure.pm +++ b/lib/Eval/Closure.pm @@ -202,9 +202,20 @@ sub _clean_eval_closure { } sub _make_compiler { - my $source = _make_compiler_source(@_); - - return @{ _clean_eval($source) }; + my $package = _next_package(); + my $source = _make_compiler_source($package, @_); + my @ret = @{ _clean_eval($source) }; + { + my ($first_fragments, $last_fragment) = ($package =~ /^(.*)::(.*)$/); + + no strict 'refs'; + # clear @ISA first, to avoid a memory leak + # see https://rt.perl.org/rt3/Public/Bug/Display.html?id=92708 + @{$package . '::ISA'} = (); + %{$package . '::'} = (); + delete ${$first_fragments . '::'}{$last_fragment . '::'}; + } + return @ret; } sub _clean_eval { @@ -215,14 +226,20 @@ sub _clean_eval { [ $compiler, $e ]; } -$Eval::Closure::SANDBOX_ID = 0; +{ + $Eval::Closure::SANDBOX_ID = 0; + + sub _next_package { + $Eval::Closure::SANDBOX_ID++; + return "Eval::Closure::Sandbox_$Eval::Closure::SANDBOX_ID"; + } +} sub _make_compiler_source { - my ($source, @capture_keys) = @_; - $Eval::Closure::SANDBOX_ID++; + my ($package, $source, @capture_keys) = @_; my $i = 0; return join "\n", ( - "package Eval::Closure::Sandbox_$Eval::Closure::SANDBOX_ID;", + "package $package;", 'sub {', (map { 'my ' . $_ . ' = ' . substr($_, 0, 1) . '{$_[' . $i++ . ']};' |