summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorBrian Fraser <fraserbn@gmail.com>2013-05-13 15:57:18 -0300
committerFather Chrysostomos <sprout@cpan.org>2013-06-09 14:23:46 -0700
commit1a4f8f41aa38eebfdff591e350c60fd1832af3fb (patch)
treef18f82415eeeafbaa0025015ec35a060938c6f7b
parent9b3e256ba8b6c2c4da93505f20c594c38b97cb81 (diff)
downloadperl-1a4f8f41aa38eebfdff591e350c60fd1832af3fb.tar.gz
Carp: Stop polluting the caller's namespace if they lack @CARP_NOT or @ISA
Turns out that this: perl -MCarp -le 'package Foo; eval { Carp::croak(1) }; print keys %Foo::;' Would leave two new symbols in Foo, CARP_NOT and ISA. This commit changes trusts_directly() to check if the symbols exists in the stash before using them.
-rw-r--r--dist/Carp/lib/Carp.pm15
-rw-r--r--dist/Carp/t/Carp.t12
2 files changed, 21 insertions, 6 deletions
diff --git a/dist/Carp/lib/Carp.pm b/dist/Carp/lib/Carp.pm
index 69caac3e26..6162177a5a 100644
--- a/dist/Carp/lib/Carp.pm
+++ b/dist/Carp/lib/Carp.pm
@@ -24,7 +24,7 @@ BEGIN {
}
}
-our $VERSION = '1.29';
+our $VERSION = '1.30';
our $MaxEvalLen = 0;
our $Verbose = 0;
@@ -431,10 +431,15 @@ sub trusts {
sub trusts_directly {
my $class = shift;
no strict 'refs';
- no warnings 'once';
- return @{"$class\::CARP_NOT"}
- ? @{"$class\::CARP_NOT"}
- : @{"$class\::ISA"};
+ my $stash = \%{"$class\::"};
+ for my $var (qw/ CARP_NOT ISA /) {
+ # Don't try using the variable until we know it exists,
+ # to avoid polluting the caller's namespace.
+ if ( $stash->{$var} && @{"$class\::$var"} ) {
+ return @{"$class\::$var"}
+ }
+ }
+ return;
}
if(!defined($warnings::VERSION) ||
diff --git a/dist/Carp/t/Carp.t b/dist/Carp/t/Carp.t
index f7c226a290..09c66524e0 100644
--- a/dist/Carp/t/Carp.t
+++ b/dist/Carp/t/Carp.t
@@ -3,7 +3,7 @@ no warnings "once";
use Config;
use IPC::Open3 1.0103 qw(open3);
-use Test::More tests => 61;
+use Test::More tests => 62;
sub runperl {
my(%args) = @_;
@@ -463,6 +463,16 @@ SKIP:
);
}
+{
+ package Foo::No::CARP_NOT;
+ eval { Carp::croak(1) };
+ ::is_deeply(
+ [ keys %Foo::No::CARP_NOT:: ],
+ [],
+ "Carp doesn't create CARP_NOT or ISA in the caller if they don't exist"
+ );
+}
+
# New tests go here
# line 1 "A"