[PATCH] Locale::Maketext - $@ being localized suppresses error on die event. #10676
Comments
From @toddrCreated by @toddrThis patch addresses CPAN RT 34182 (Locale::Maketext). $@ is localized only in scope so die messages fall through when desired. Previously, there was test code to make sure Perl Info |
From @toddrcommit 46d33563971797366d5a085fcf898e4523a11d83 CPAN RT 34182 (Locale::Maketext) - Don't unnecessarily localize $@. Inline Patchdiff --git a/dist/Locale-Maketext/lib/Locale/Maketext.pm b/dist/Locale-Maketext/lib/Locale/Maketext.pm
index 5479a60..f760d4f 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,10 +194,6 @@ 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 $@;
-
# Look up the value:
my $value;
@@ -272,12 +267,11 @@ 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.
}
@@ -434,10 +428,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..17ae48a
--- /dev/null
+++ b/dist/Locale-Maketext/t/30_eval_dollar_at.t
@@ -0,0 +1,49 @@
+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 => 9;
+
+my $lh = TEST->get_handle('en');
+is($lh->maketext("This works fine"), "This works fine", "straight forward _AUTO string test");
+
+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 $@
+$@ = '';
+is(Locale::Maketext::_try_use("This::module::does::not::exist"), 0, "0 return if module is missing when _try_use is called");
+is($@, '', '$@ is clean after 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 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"); |
From @cpansproutOn Tue Sep 28 13:41:01 2010, toddr@cpanel.net wrote:
Concerning these two lines: Code that currently relies on $@ keeping its existing value will start (BTW, the local |
|
The RT System itself - Status changed from 'new' to 'open' |
From @toddrOn Oct 3, 2010, at 4:20 PM, Father Chrysostomos via RT wrote:
I agree with you about current code depending on $@ being localized. Attached is the diff for the additional code. |
From @toddrInline Patchdiff --git a/dist/Locale-Maketext/lib/Locale/Maketext.pm b/dist/Locale-Maketext/lib/Locale/Maketext.pm
index f760d4f..5b367ff 100644
--- a/dist/Locale-Maketext/lib/Locale/Maketext.pm
+++ b/dist/Locale-Maketext/lib/Locale/Maketext.pm
@@ -27,7 +27,7 @@ BEGIN {
}
-$VERSION = '1.16';
+$VERSION = '1.15_01';
@ISA = ();
$MATCH_SUPERS = 1;
@@ -194,6 +194,10 @@ 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 = $@;
+
# Look up the value:
my $value;
@@ -243,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.
}
@@ -257,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__'};
@@ -276,8 +288,10 @@ sub maketext {
# 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.
}
###########################################################################
diff --git a/dist/Locale-Maketext/t/30_eval_dollar_at.t b/dist/Locale-Maketext/t/30_eval_dollar_at.t
index 17ae48a..523365d 100644
--- a/dist/Locale-Maketext/t/30_eval_dollar_at.t
+++ b/dist/Locale-Maketext/t/30_eval_dollar_at.t
@@ -17,10 +17,12 @@ use warnings;
package main;
use strict;
use warnings;
-use Test::More tests => 9;
+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');
@@ -29,9 +31,9 @@ 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($@, '', '$@ is clean after failed _try_use');
+is($@, 'foo2', '$@ is unmodified by a failed _try_use');
# _try_use doesn't pollute $@ for valid call
$@ = ''; |
From @toddrThe revised full patch (patch2.txt) is also attached: |
From @toddrcommit 17a38f9c9a77c2e7c8d5bff45e8363c50c5578c5 CPAN RT 34182 (Locale::Maketext) - Don't unnecessarily localize $@. Inline Patch |
From @toddr
#p5p just pointed out I accidentally downgraded the version. Submitting patch3.txt |
From @toddrcommit 17a38f9c9a77c2e7c8d5bff45e8363c50c5578c5 CPAN RT 34182 (Locale::Maketext) - Don't unnecessarily localize $@. Inline Patch |
From @cpansproutOn Mon Oct 04 14:08:05 2010, toddr@cpanel.net wrote:
Thank you. Applied as 9961f4d. |
|
@cpansprout - Status changed from 'open' to 'resolved' |
Migrated from rt.perl.org#78108 (status was 'resolved')
Searchable as RT78108$
The text was updated successfully, but these errors were encountered: