In perl.git, the branch blead has been updated
<http://perl5.git.perl.org/perl.git/commitdiff/edf72ff9d4c8887a03cce52d996b565862ed1630?hp=afa74577a6e8d7cf96f7c62e4acca52fda973699>
- Log -----------------------------------------------------------------
commit edf72ff9d4c8887a03cce52d996b565862ed1630
Author: Father Chrysostomos <spr...@cpan.org>
Date: Mon Oct 4 21:45:24 2010 -0700
perldelta entry for Locale::Maketext/$@
M pod/perldelta.pod
commit bac7bf84e9730a396813e97488e4405bf1cfad9b
Author: Father Chrysostomos <spr...@cpan.org>
Date: Mon Oct 4 21:45:16 2010 -0700
Re-add a test deleted by the recent Locale::Maketext/$@ change
(and make it pass, too)
M dist/Locale-Maketext/lib/Locale/Maketext.pm
M dist/Locale-Maketext/t/30_eval_dollar_at.t
commit c30aeddd3b36c37c0ba6fe204d0eacb3edb28f0a
Author: Father Chrysostomos <spr...@cpan.org>
Date: Mon Oct 4 20:21:06 2010 -0700
Update MANIFEST for prev. Locale::Maketext change
M MANIFEST
commit 9961f4dd2912b4ce1be748ce46a7bbd36ac60251
Author: Todd Rinaldo <to...@cpan.org>
Date: Mon Oct 4 20:15:59 2010 -0700
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
M dist/Locale-Maketext/ChangeLog
M dist/Locale-Maketext/lib/Locale/Maketext.pm
A dist/Locale-Maketext/t/30_eval_dollar_at.t
D dist/Locale-Maketext/t/30_local.t
-----------------------------------------------------------------------
Summary of changes:
MANIFEST | 2 +-
dist/Locale-Maketext/ChangeLog | 3 +
dist/Locale-Maketext/lib/Locale/Maketext.pm | 40 +++++++++++++-------
dist/Locale-Maketext/t/30_eval_dollar_at.t | 55 +++++++++++++++++++++++++++
dist/Locale-Maketext/t/30_local.t | 23 -----------
pod/perldelta.pod | 4 ++
6 files changed, 89 insertions(+), 38 deletions(-)
create mode 100644 dist/Locale-Maketext/t/30_eval_dollar_at.t
delete mode 100644 dist/Locale-Maketext/t/30_local.t
diff --git a/MANIFEST b/MANIFEST
index becb633..a773176 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -2763,7 +2763,7 @@ dist/Locale-Maketext/t/04_use_external_lex_cache.t
See if Locale::Maketext works
dist/Locale-Maketext/t/09_compile.t Test Locale::Maketext::_compile
dist/Locale-Maketext/t/10_make.t See if Locale::Maketext
works
dist/Locale-Maketext/t/20_get.t See if
Locale::Maketext works
-dist/Locale-Maketext/t/30_local.t See if Locale::Maketext
works
+dist/Locale-Maketext/t/30_eval_dollar_at.t See if Locale::Maketext
works
dist/Locale-Maketext/t/40_super.t See if Locale::Maketext
works
dist/Locale-Maketext/t/50_super.t See if Locale::Maketext
works
dist/Locale-Maketext/t/60_super.t See if Locale::Maketext
works
diff --git a/dist/Locale-Maketext/ChangeLog b/dist/Locale-Maketext/ChangeLog
index 16891a1..a8af658 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 5479a60..103df9e 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,12 @@ sub maketext {
my($handle, $phrase) = splice(@_,0,2);
Carp::confess('No handle/phrase') unless (defined($handle) &&
defined($phrase));
+ # 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 = $@;
- # Don't interefere with $@ in case that's being interpolated into the msg.
- local $@;
+ # Copy @_ case one of its elements is $...@.
+ @_ = @_;
# Look up the value:
@@ -248,10 +250,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 +266,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 +282,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 +445,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 0000000..33581b3
--- /dev/null
+++ b/dist/Locale-Maketext/t/30_eval_dollar_at.t
@@ -0,0 +1,55 @@
+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 => 12;
+
+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.");
+}
+
+$@ = '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");
diff --git a/dist/Locale-Maketext/t/30_local.t
b/dist/Locale-Maketext/t/30_local.t
deleted file mode 100644
index 23fa2ac..0000000
--- 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");
diff --git a/pod/perldelta.pod b/pod/perldelta.pod
index 7e1cca2..74a1082 100644
--- a/pod/perldelta.pod
+++ b/pod/perldelta.pod
@@ -252,6 +252,10 @@ It fixes an infinite loop in
C<Locale::Maketext::Guts::_compile()> when
working with tainted values
(L<CPAN RT #40727|https://rt.cpan.org/Public/Bug/Display.html?id=40727>).
+C<< ->maketext >> calls will now backup and restore C<$@> so that error
+messages are not supressed
+(L<CPAN RT #34182|https://rt.cpan.org/Public/Bug/Display.html?id=34182>).
+
=item *
C<Math::BigInt> has been upgraded from version 1.95 to 1.96.
--
Perl5 Master Repository
