From 21665b5f20fc7c96f4819bc1b754980e77849c05 Mon Sep 17 00:00:00 2001 From: Jesse Luehrs Date: Thu, 29 Mar 2012 03:10:20 -0500 Subject: get rid of the _< thing if it's not a real filename --- lib/Eval/Closure.pm | 13 ++++++++++++- t/clean-main-stash.t | 53 ++++++++++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 65 insertions(+), 1 deletion(-) create mode 100644 t/clean-main-stash.t diff --git a/lib/Eval/Closure.pm b/lib/Eval/Closure.pm index 161bcdf..46a3448 100644 --- a/lib/Eval/Closure.pm +++ b/lib/Eval/Closure.pm @@ -100,12 +100,23 @@ sub eval_closure { $args{source} = _canonicalize_source($args{source}); _validate_env($args{environment} ||= {}); + my $should_set_description = defined $args{description} && !($^P & 0x10); + $args{source} = _line_directive(@args{qw(line description)}) . $args{source} - if defined $args{description} && !($^P & 0x10); + if $should_set_description; + + my $existed_before; + $existed_before = exists $::{"_<$args{description}"} + if $should_set_description; my ($code, $e) = _clean_eval_closure(@args{qw(source environment)}); + if (!$existed_before && $should_set_description) { + # this will be meaningless, and just leaks memory + delete $::{"_<$args{description}"}; + } + if (!$code) { if ($args{terse_error}) { die "$e\n"; diff --git a/t/clean-main-stash.t b/t/clean-main-stash.t new file mode 100644 index 0000000..2aa0b9a --- /dev/null +++ b/t/clean-main-stash.t @@ -0,0 +1,53 @@ +#!/usr/bin/env perl +use strict; +use warnings; +use Test::More; + +use Eval::Closure; + +{ + my @keys_before = keys %::; + + my $sub = eval_closure( + source => 'sub { 1 }', + description => 'foo', + ); + + is_deeply([sort keys %::], [sort @keys_before]); +} + +{ + my @keys_before = keys %::; + + my $sub = eval_closure( + source => 'sub { 1 }', + line => 100, + ); + + is_deeply([sort keys %::], [sort @keys_before]); +} + +{ + my @keys_before = keys %::; + + my $sub = eval_closure( + source => 'sub { 1 }', + description => 'foo', + line => 100, + ); + + is_deeply([sort keys %::], [sort @keys_before]); +} + +{ + my @keys_before = keys %::; + + my $sub = eval_closure( + source => 'sub { 1 }', + description => __FILE__, + ); + + is_deeply([sort keys %::], [sort @keys_before]); +} + +done_testing; -- cgit v1.2.3-54-g00ecf