diff options
| -rw-r--r-- | dist/Locale-Maketext/ChangeLog | 3 | ||||
| -rw-r--r-- | dist/Locale-Maketext/lib/Locale/Maketext.pm | 39 | ||||
| -rw-r--r-- | dist/Locale-Maketext/t/30_eval_dollar_at.t | 51 | ||||
| -rw-r--r-- | dist/Locale-Maketext/t/30_local.t | 23 |
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"); |