Cleaned up warning messages in pad.c, plus related tests.

diff --git a/pad.c b/pad.c
index c0160d1..6823e68 100644 (file)
--- 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 (file)
--- 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.
+########