summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorTodd Rinaldo <toddr@cpan.org>2010-10-04 20:15:59 -0700
committerFather Chrysostomos <sprout@cpan.org>2010-10-04 20:15:59 -0700
commit9961f4dd2912b4ce1be748ce46a7bbd36ac60251 (patch)
treea7e9e487492f7a40a2f38e74964f2bb13b3d1428
parentafa74577a6e8d7cf96f7c62e4acca52fda973699 (diff)
downloadperl-9961f4dd2912b4ce1be748ce46a7bbd36ac60251.tar.gz
CPAN RT 34182 (Locale::Maketext) - Don't unnecessarily localize $@.
Do it in scope only so die messages fall through when desired. Previously, there was test code to make sure $@ was not modified when maketext is called, but if the caller wraps maketext in an eval, then it's going to be modified anyways to '' at the least. If the caller does not wrap a maketext call in an eval and maketext dies, then hiding the $@ simply confuses the person debugging as to what went wrong. We do however backup/restore $@ so that it does not break any code that looks might use $@ after a successful call to maketext. eval {...} $lm->maketext($@); do_something_else($@); In the above example, $@ would be the same when passed to do_something_else
-rw-r--r--dist/Locale-Maketext/ChangeLog3
-rw-r--r--dist/Locale-Maketext/lib/Locale/Maketext.pm39
-rw-r--r--dist/Locale-Maketext/t/30_eval_dollar_at.t51
-rw-r--r--dist/Locale-Maketext/t/30_local.t23
4 files changed, 78 insertions, 38 deletions
diff --git a/dist/Locale-Maketext/ChangeLog b/dist/Locale-Maketext/ChangeLog
index 16891a1fb4..a8af6589eb 100644
--- a/dist/Locale-Maketext/ChangeLog
+++ b/dist/Locale-Maketext/ChangeLog
@@ -6,6 +6,9 @@ Revision history for Perl suite Locale::Maketext
Fix for CPAN RT #40727: infinite loop in
Locale::Maketext::Guts::_compile() when working with tainted values
+ Fix for CPAN RT #34182: Don't localize $@.
+ ->maketext calls will now backup and restore $@ so that die messages are not supressed.
+
2010−06−22
* Release 1.15 (included in perl 5.13.3; not released separately)
diff --git a/dist/Locale-Maketext/lib/Locale/Maketext.pm b/dist/Locale-Maketext/lib/Locale/Maketext.pm
index 5479a60d2a..71d358824d 100644
--- a/dist/Locale-Maketext/lib/Locale/Maketext.pm
+++ b/dist/Locale-Maketext/lib/Locale/Maketext.pm
@@ -160,12 +160,11 @@ sub failure_handler_auto {
# If we make it here, there was an exception thrown in the
# call to $value, and so scream:
if($@) {
- my $err = $@;
# pretty up the error message
- $err =~ s{\s+at\s+\(eval\s+\d+\)\s+line\s+(\d+)\.?\n?}
+ $@ =~ s{\s+at\s+\(eval\s+\d+\)\s+line\s+(\d+)\.?\n?}
{\n in bracket code [compiled line $1],}s;
#$err =~ s/\n?$/\n/s;
- Carp::croak "Error in maketexting \"$phrase\":\n$err as used";
+ Carp::croak "Error in maketexting \"$phrase\":\n$@ as used";
# Rather unexpected, but suppose that the sub tried calling
# a method that didn't exist.
}
@@ -195,9 +194,9 @@ sub maketext {
my($handle, $phrase) = splice(@_,0,2);
Carp::confess('No handle/phrase') unless (defined($handle) && defined($phrase));
-
- # Don't interefere with $@ in case that's being interpolated into the msg.
- local $@;
+ # backup $@ in case it it's still being used in the calling code.
+ # If no failures, we'll re-set it back to what it was later.
+ my $at = $@;
# Look up the value:
@@ -248,10 +247,12 @@ sub maketext {
DEBUG and warn "WARNING0: maketext fails looking for <$phrase>\n";
my $fail;
if(ref($fail = $handle->{'fail'}) eq 'CODE') { # it's a sub reference
+ $@ = $at; # Put $@ back in case we altered it along the way.
return &{$fail}($handle, $phrase, @_);
# If it ever returns, it should return a good value.
}
else { # It's a method name
+ $@ = $at; # Put $@ back in case we altered it along the way.
return $handle->$fail($phrase, @_);
# If it ever returns, it should return a good value.
}
@@ -262,8 +263,14 @@ sub maketext {
}
}
- return $$value if ref($value) eq 'SCALAR';
- return $value unless ref($value) eq 'CODE';
+ if(ref($value) eq 'SCALAR'){
+ $@ = $at; # Put $@ back in case we altered it along the way.
+ return $$value ;
+ }
+ if(ref($value) ne 'CODE'){
+ $@ = $at; # Put $@ back in case we altered it along the way.
+ return $value ;
+ }
{
local $SIG{'__DIE__'};
@@ -272,18 +279,19 @@ sub maketext {
# If we make it here, there was an exception thrown in the
# call to $value, and so scream:
if ($@) {
- my $err = $@;
# pretty up the error message
- $err =~ s{\s+at\s+\(eval\s+\d+\)\s+line\s+(\d+)\.?\n?}
+ $@ =~ s{\s+at\s+\(eval\s+\d+\)\s+line\s+(\d+)\.?\n?}
{\n in bracket code [compiled line $1],}s;
#$err =~ s/\n?$/\n/s;
- Carp::croak "Error in maketexting \"$phrase\":\n$err as used";
+ Carp::croak "Error in maketexting \"$phrase\":\n$@ as used";
# Rather unexpected, but suppose that the sub tried calling
# a method that didn't exist.
}
else {
+ $@ = $at; # Put $@ back in case we altered it along the way.
return $value;
}
+ $@ = $at; # Put $@ back in case we altered it along the way.
}
###########################################################################
@@ -434,10 +442,11 @@ sub _try_use { # Basically a wrapper around "require Modulename"
}
DEBUG and warn " About to use $module ...\n";
- {
- local $SIG{'__DIE__'};
- eval "require $module"; # used to be "use $module", but no point in that.
- }
+
+ local $SIG{'__DIE__'};
+ local $@;
+ eval "require $module"; # used to be "use $module", but no point in that.
+
if($@) {
DEBUG and warn "Error using $module \: $@\n";
return $tried{$module} = 0;
diff --git a/dist/Locale-Maketext/t/30_eval_dollar_at.t b/dist/Locale-Maketext/t/30_eval_dollar_at.t
new file mode 100644
index 0000000000..523365de67
--- /dev/null
+++ b/dist/Locale-Maketext/t/30_eval_dollar_at.t
@@ -0,0 +1,51 @@
+use strict;
+use warnings;
+
+{
+ package TEST;
+ use base 'Locale::Maketext';
+}
+
+{
+ package TEST::en;
+ use base 'TEST';
+ our %Lexicon = (
+ _AUTO => 1,
+ );
+}
+
+package main;
+use strict;
+use warnings;
+use Test::More tests => 10;
+
+my $lh = TEST->get_handle('en');
+$@ = "foo";
+is($lh->maketext("This works fine"), "This works fine", "straight forward _AUTO string test");
+is($@, "foo", q{$@ isn't altered during calls to maketext});
+
+my $err = eval {
+ $lh->maketext('this is ] an error');
+};
+is($err, undef, "no return from eval");
+like("$@", qr/Unbalanced\s'\]',\sin/ms, '$@ shows that ] was unbalanced');
+
+# _try_use doesn't pollute $@
+$@ = 'foo2';
+is(Locale::Maketext::_try_use("This::module::does::not::exist"), 0, "0 return if module is missing when _try_use is called");
+is($@, 'foo2', '$@ is unmodified by a failed _try_use');
+
+# _try_use doesn't pollute $@ for valid call
+$@ = '';
+is(Locale::Maketext::_try_use("Locale::Maketext::Guts"), 1, "1 return using valid module Locale::Maketext::Guts");
+is($@, '', '$@ is clean after failed _try_use');
+
+# failure_handler_auto handles $@ locally.
+{
+ $@ = '';
+ my $err = '';
+ $lh->{failure_lex}->{"foo_fail"} = sub {die("fail message");};
+ $err = eval {$lh->failure_handler_auto("foo_fail")};
+ is($err, undef, "die event calling failure_handler on bad code");
+ like($@, qr/^Error in maketexting "foo_fail":/ms, "\$@ is re-written as expected.");
+}
diff --git a/dist/Locale-Maketext/t/30_local.t b/dist/Locale-Maketext/t/30_local.t
deleted file mode 100644
index 23fa2ac551..0000000000
--- a/dist/Locale-Maketext/t/30_local.t
+++ /dev/null
@@ -1,23 +0,0 @@
-#!/usr/bin/perl -Tw
-
-use strict;
-
-use Test::More tests => 3;
-use Locale::Maketext;
-
-# declare a class...
-{
- package Woozle;
- our @ISA = ('Locale::Maketext');
- our %Lexicon = (
- _AUTO => 1
- );
- keys %Lexicon; # dodges the 'used only once' warning
-}
-
-my $lh = Woozle->new();
-isa_ok($lh, 'Woozle');
-
-$@ = 'foo';
-is($lh->maketext('Eval error: [_1]', $@), 'Eval error: foo', "Make sure \$@ is localized when passed to maketext");
-is($@, 'foo', "\$@ wasn't modified during call");