summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorBrian Fraser <fraserbn@gmail.com>2011-06-11 15:53:43 -0300
committerFather Chrysostomos <sprout@cpan.org>2011-07-12 21:46:54 -0700
commit0727928ebd4d5aa9e77d5109e10966af77339480 (patch)
tree5bfe686fdd2cfb18c20bf6c57d96b92c9975d0ca
parentab8f91e928bd083c5c24dda5ab81ff3707aef750 (diff)
downloadperl-0727928ebd4d5aa9e77d5109e10966af77339480.tar.gz
Cleaned up warning messages in pad.c, plus related tests.
-rw-r--r--pad.c25
-rw-r--r--t/lib/warnings/pad245
2 files changed, 261 insertions, 9 deletions
diff --git a/pad.c b/pad.c
index c0160d10f1..6823e68af0 100644
--- a/pad.c
+++ b/pad.c
@@ -553,8 +553,8 @@ Perl_pad_add_name_pvn(pTHX_ const char *namepv, STRLEN namelen,
namepv = (const char*)bytes_from_utf8((U8*)namepv, &namelen, &is_utf8);
}
- sv_setpvn(namesv, namepv, namelen);
-
+ sv_setpvn(namesv, namepv, namelen);
+
if (is_utf8) {
flags |= padadd_UTF8_NAME;
SvUTF8_on(namesv);
@@ -1145,8 +1145,11 @@ S_pad_findlex(pTHX_ const char *namepv, STRLEN namelen, U32 flags, const CV* cv,
{
if (warn)
Perl_ck_warner(aTHX_ packWARN(WARN_CLOSURE),
- "Variable \"%.*s\" is not available",
- namelen, namepv);
+ "Variable \"%"SVf"\" is not available",
+ newSVpvn_flags(namepv, namelen,
+ SVs_TEMP |
+ (flags & padadd_UTF8_NAME ? SVf_UTF8 : 0)));
+
*out_capture = NULL;
}
@@ -1158,8 +1161,10 @@ S_pad_findlex(pTHX_ const char *namepv, STRLEN namelen, U32 flags, const CV* cv,
&& warn && ckWARN(WARN_CLOSURE)) {
newwarn = 0;
Perl_warner(aTHX_ packWARN(WARN_CLOSURE),
- "Variable \"%.*s\" will not stay shared",
- namelen, namepv);
+ "Variable \"%"SVf"\" will not stay shared",
+ newSVpvn_flags(namepv, namelen,
+ SVs_TEMP |
+ (flags & padadd_UTF8_NAME ? SVf_UTF8 : 0)));
}
if (fake_offset && CvANON(cv)
@@ -1188,8 +1193,10 @@ S_pad_findlex(pTHX_ const char *namepv, STRLEN namelen, U32 flags, const CV* cv,
&& !SvPAD_STATE(name_svp[offset]))
{
Perl_ck_warner(aTHX_ packWARN(WARN_CLOSURE),
- "Variable \"%.*s\" is not available",
- namelen, namepv);
+ "Variable \"%"SVf"\" is not available",
+ newSVpvn_flags(namepv, namelen,
+ SVs_TEMP |
+ (flags & padadd_UTF8_NAME ? SVf_UTF8 : 0)));
*out_capture = NULL;
}
}
@@ -1906,7 +1913,7 @@ Perl_cv_clone(pTHX_ CV *proto)
stale. And state vars are always available */
if (SvPADSTALE(sv) && !SvPAD_STATE(namesv)) {
Perl_ck_warner(aTHX_ packWARN(WARN_CLOSURE),
- "Variable \"%s\" is not available", SvPVX_const(namesv));
+ "Variable \"%"SVf"\" is not available", namesv);
sv = NULL;
}
else
diff --git a/t/lib/warnings/pad b/t/lib/warnings/pad
index 54d72cdef9..b226239ab1 100644
--- a/t/lib/warnings/pad
+++ b/t/lib/warnings/pad
@@ -327,3 +327,248 @@ our $ouch;
our $_;
EXPECT
"our" variable $_ redeclared at - line 6.
+########
+use warnings 'misc';
+BEGIN { binmode STDERR, 'utf8'; }
+{
+ use utf8;
+ my $ニコニコ;
+ my $ニコニコ;
+}
+EXPECT
+"my" variable $ニコニコ masks earlier declaration in same scope at - line 6.
+########
+use warnings 'misc';
+BEGIN { binmode STDERR, 'utf8'; }
+{
+ use utf8;
+ my $thìs;
+ my $thìs;
+}
+EXPECT
+"my" variable $thìs masks earlier declaration in same scope at - line 6.
+########
+# pad.c
+use warnings 'closure' ;
+BEGIN { binmode STDERR, 'utf8'; }
+sub {
+ use utf8;
+ my $è;
+ sub f { $è }
+}->();
+EXPECT
+Variable "$è" is not available at - line 7.
+########
+# pad.c
+use warnings 'closure' ;
+BEGIN { binmode STDERR, 'utf8'; }
+sub {
+ use utf8;
+ my $ニ;
+ sub f { $ニ }
+}->();
+EXPECT
+Variable "$ニ" is not available at - line 7.
+########
+# pad.c
+use warnings 'closure' ;
+BEGIN { binmode STDERR, 'utf8'; }
+sub x {
+ use utf8;
+ my $に;
+ sub y {
+ $に
+ }
+ }
+EXPECT
+Variable "$に" will not stay shared at - line 9.
+########
+# pad.c
+use warnings 'closure' ;
+BEGIN { binmode STDERR, 'utf8'; }
+sub x {
+ use utf8;
+ my $に;
+ sub y {
+ sub { $に }
+ }
+ }
+EXPECT
+Variable "$に" will not stay shared at - line 8.
+########
+# pad.c
+use warnings 'closure' ;
+BEGIN { binmode STDERR, 'utf8'; }
+sub x {
+ use utf8;
+ my $に;
+ sub {
+ $に;
+ sub y {
+ $に
+ }
+ }->();
+}
+EXPECT
+Variable "$に" will not stay shared at - line 11.
+########
+# pad.c
+use warnings 'closure' ;
+BEGIN { binmode STDERR, 'utf8'; }
+sub {
+ use utf8;
+ my $に;
+ sub f { $に }
+}->();
+EXPECT
+Variable "$に" is not available at - line 7.
+########
+# pad.c
+use warnings 'closure' ;
+BEGIN { binmode STDERR, 'utf8'; }
+sub {
+ use utf8;
+ my $に;
+ sub f { eval '$に' }
+}->();
+f();
+EXPECT
+Variable "$に" is not available at (eval 1) line 2.
+########
+# pad.c
+# see bugid 1754
+use warnings 'closure' ;
+BEGIN { binmode STDERR, 'utf8'; }
+sub f {
+ use utf8;
+ my $に;
+ sub { eval '$に' };
+}
+f()->();
+EXPECT
+Variable "$に" is not available at (eval 1) line 2.
+########
+use warnings 'closure' ;
+BEGIN { binmode STDERR, 'utf8'; }
+{
+ use utf8;
+ my $に = 1;
+ $y = \$に; # force abandonment rather than clear-in-place at scope exit
+ sub f2 { eval '$に' }
+}
+f2();
+EXPECT
+Variable "$に" is not available at (eval 1) line 2.
+########
+use warnings 'closure' ;
+BEGIN { binmode STDERR, 'utf8'; }
+use utf8;
+for my $に (1,2,3) {
+ sub f { eval '$に' }
+ f();
+}
+f();
+EXPECT
+Variable "$に" is not available at (eval 4) line 2.
+########
+# pad.c
+use warnings 'closure' ;
+BEGIN { binmode STDERR, 'utf8'; }
+sub x {
+ use utf8;
+ my $è;
+ sub y {
+ $è
+ }
+ }
+EXPECT
+Variable "$è" will not stay shared at - line 9.
+########
+# pad.c
+use warnings 'closure' ;
+BEGIN { binmode STDERR, 'utf8'; }
+sub x {
+ use utf8;
+ my $è;
+ sub y {
+ sub { $è }
+ }
+ }
+EXPECT
+Variable "$è" will not stay shared at - line 8.
+########
+# pad.c
+use warnings 'closure' ;
+BEGIN { binmode STDERR, 'utf8'; }
+sub x {
+ use utf8;
+ my $è;
+ sub {
+ $è;
+ sub y {
+ $è
+ }
+ }->();
+}
+EXPECT
+Variable "$è" will not stay shared at - line 11.
+########
+# pad.c
+use warnings 'closure' ;
+BEGIN { binmode STDERR, 'utf8'; }
+sub {
+ use utf8;
+ my $è;
+ sub f { $è }
+}->();
+EXPECT
+Variable "$è" is not available at - line 7.
+########
+# pad.c
+use warnings 'closure' ;
+BEGIN { binmode STDERR, 'utf8'; }
+sub {
+ use utf8;
+ my $è;
+ sub f { eval '$è' }
+}->();
+f();
+EXPECT
+Variable "$è" is not available at (eval 1) line 2.
+########
+# pad.c
+# see bugid 1754
+use warnings 'closure' ;
+BEGIN { binmode STDERR, 'utf8'; }
+sub f {
+ use utf8;
+ my $è;
+ sub { eval '$è' };
+}
+f()->();
+EXPECT
+Variable "$è" is not available at (eval 1) line 2.
+########
+use warnings 'closure' ;
+BEGIN { binmode STDERR, 'utf8'; }
+{
+ use utf8;
+ my $è = 1;
+ $y = \$è; # force abandonment rather than clear-in-place at scope exit
+ sub f2 { eval '$è' }
+}
+f2();
+EXPECT
+Variable "$è" is not available at (eval 1) line 2.
+########
+use warnings 'closure' ;
+BEGIN { binmode STDERR, 'utf8'; }
+use utf8;
+for my $è (1,2,3) {
+ sub f { eval '$è' }
+ f();
+}
+f();
+EXPECT
+Variable "$è" is not available at (eval 4) line 2.
+########