From 0727928ebd4d5aa9e77d5109e10966af77339480 Mon Sep 17 00:00:00 2001 From: Brian Fraser Date: Sat, 11 Jun 2011 15:53:43 -0300 Subject: [PATCH] Cleaned up warning messages in pad.c, plus related tests. --- pad.c | 25 ++++-- t/lib/warnings/pad | 245 +++++++++++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 261 insertions(+), 9 deletions(-) diff --git a/pad.c b/pad.c index c0160d1..6823e68 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 54d72cd..b226239 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. +######## -- 2.7.4