Make op.c warnings UTF8-clean

diff --git a/op.c b/op.c
index f5654cd..49c1513 100644 (file)
--- a/op.c
+++ b/op.c
@@ -987,6 +987,7 @@ Perl_scalarvoid(pTHX_ OP *o)
     dVAR;
     OP *kid;
     const char* useless = NULL;
+    U32 useless_is_utf8 = 0;
     SV* sv;
     U8 want;
 
@@ -1167,6 +1168,7 @@ Perl_scalarvoid(pTHX_ OP *o)
                    SV* msv = sv_2mortal(Perl_newSVpvf(aTHX_
                                "a constant (%"SVf")", sv));
                    useless = SvPV_nolen(msv);
+                    useless_is_utf8 = SvUTF8(msv);
                }
                else
                    useless = "a constant (undef)";
@@ -1316,7 +1318,9 @@ Perl_scalarvoid(pTHX_ OP *o)
        return scalar(o);
     }
     if (useless)
-       Perl_ck_warner(aTHX_ packWARN(WARN_VOID), "Useless use of %s in void context", useless);
+       Perl_ck_warner(aTHX_ packWARN(WARN_VOID), "Useless use of %"SVf" in void context",
+                       newSVpvn_flags(useless, strlen(useless),
+                            SVs_TEMP | ( useless_is_utf8 ? SVf_UTF8 : 0 )));
     return o;
 }
 
@@ -6542,8 +6546,9 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
                    if (PL_parser && PL_parser->copline != NOLINE)
                        CopLINE_set(PL_curcop, PL_parser->copline);
                    Perl_warner(aTHX_ packWARN(WARN_REDEFINE),
-                       CvCONST(cv) ? "Constant subroutine %s redefined"
-                                   : "Subroutine %s redefined", name);
+                       CvCONST(cv) ? "Constant subroutine %"SVf" redefined"
+                                   : "Subroutine %"SVf" redefined",
+                                    SVfARG(cSVOPo->op_sv));
                    CopLINE_set(PL_curcop, oldline);
                }
 #ifdef PERL_MAD

diff --git a/sv.c b/sv.c
index 60708b1..e542788 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -3846,10 +3846,10 @@ S_glob_assign_ref(pTHX_ SV *const dstr, SV *const sstr)
                            Perl_warner(aTHX_ packWARN(WARN_REDEFINE),
                                        (const char *)
                                        (CvCONST(cv)
-                                        ? "Constant subroutine %s::%s redefined"
-                                        : "Subroutine %s::%s redefined"),
-                                       HvNAME_get(GvSTASH((const GV *)dstr)),
-                                       GvENAME(MUTABLE_GV(dstr)));
+                                        ? "Constant subroutine %"SVf"::%"SVf" redefined"
+                                        : "Subroutine %"SVf"::%"SVf" redefined"),
+               SVfARG(sv_2mortal(newSVhek(HvNAME_HEK(GvSTASH((const GV *)dstr))))),
+               SVfARG(sv_2mortal(newSVhek(GvENAME_HEK(MUTABLE_GV(dstr))))));
                        }
                    }
                if (!intro)

diff --git a/t/lib/strict/subs b/t/lib/strict/subs
index 84bf874..57327cc 100644 (file)
--- a/t/lib/strict/subs
+++ b/t/lib/strict/subs
@@ -381,6 +381,15 @@ EXPECT
 Bareword "foo" not allowed while "strict subs" in use at (re_eval 1) line 1.
 Compilation failed in regexp at - line 3.
 ########
+# Regexp compilation errors weren't UTF-8 clean
+use strict 'subs';
+use utf8;
+use open qw( :utf8 :std );
+qr/(?{my $x=fòò})/;
+EXPECT
+Bareword "fòò" not allowed while "strict subs" in use at (re_eval 1) line 1.
+Compilation failed in regexp at - line 5.
+########
 #  [perl #27628] strict 'subs' didn't warn on bareword array index
 use strict 'subs';
 my $x=$a[FOO];

diff --git a/t/lib/strict/vars b/t/lib/strict/vars
index 804d7ec..d41aa3c 100644 (file)
--- a/t/lib/strict/vars
+++ b/t/lib/strict/vars
@@ -83,6 +83,21 @@ Execution of - aborted due to compilation errors.
 ########
 
 # Check compile time scope of strict vars pragma
+use strict 'vars' ;
+use utf8;
+use open qw( :utf8 :std );
+{
+    no strict ;
+    $jòè = 1 ;
+}
+$jòè = 1 ;
+EXPECT
+Variable "$jòè" is not imported at - line 10.
+Global symbol "$jòè" requires explicit package name at - line 10.
+Execution of - aborted due to compilation errors.
+########
+
+# Check compile time scope of strict vars pragma
 no strict;
 {
     use strict 'vars' ;
@@ -127,6 +142,23 @@ Global symbol "$joe" requires explicit package name at ./abc line 2.
 Compilation failed in require at - line 2.
 ########
 
+--FILE-- abc
+use strict 'vars' ;
+use utf8;
+use open qw( :utf8 :std );
+$jòè = 1 ;
+1;
+--FILE-- 
+use utf8;
+use open qw( :utf8 :std );
+$jòè = 1 ;
+require "./abc";
+EXPECT
+Variable "$jòè" is not imported at ./abc line 4.
+Global symbol "$jòè" requires explicit package name at ./abc line 4.
+Compilation failed in require at - line 4.
+########
+
 --FILE-- abc.pm
 use strict 'vars' ;
 $joe = 1 ;
@@ -142,6 +174,24 @@ BEGIN failed--compilation aborted at - line 2.
 ########
 
 --FILE-- abc.pm
+use strict 'vars' ;
+use utf8;
+use open qw( :utf8 :std );
+$jòè = 1 ;
+1;
+--FILE-- 
+use utf8;
+use open qw( :utf8 :std );
+$jòè = 1 ;
+use abc;
+EXPECT
+Variable "$jòè" is not imported at abc.pm line 4.
+Global symbol "$jòè" requires explicit package name at abc.pm line 4.
+Compilation failed in require at - line 4.
+BEGIN failed--compilation aborted at - line 4.
+########
+
+--FILE-- abc.pm
 package Burp;
 use strict;
 $a = 1;$f = 1;$k = 1; # just to get beyond the limit...
@@ -225,6 +275,22 @@ Execution of - aborted due to compilation errors.
 ########
 
 # Check scope of pragma with eval
+use strict 'vars' ;
+use utf8;
+use open qw( :utf8 :std );
+eval {
+    no strict ;
+    $jòè = 1 ;
+};
+print STDERR $@;
+$jòè = 1 ;
+EXPECT
+Variable "$jòè" is not imported at - line 11.
+Global symbol "$jòè" requires explicit package name at - line 11.
+Execution of - aborted due to compilation errors.
+########
+
+# Check scope of pragma with eval
 no strict ;
 eval '
     $joe = 1 ;
@@ -337,6 +403,21 @@ Global symbol "$fred" requires explicit package name at - line 8.
 Execution of - aborted due to compilation errors.
 ########
 
+# strict vars with elapsed our - error
+use strict 'vars' ;
+use utf8;
+use open qw( :utf8 :std );
+sub fòò {
+    our $frèd;
+    $frèd;
+}
+$frèd ;
+EXPECT
+Variable "$frèd" is not imported at - line 10.
+Global symbol "$frèd" requires explicit package name at - line 10.
+Execution of - aborted due to compilation errors.
+########
+
 # nested our with local - no error
 $fred = 1;
 use strict 'vars';
@@ -440,6 +521,15 @@ EXPECT
 Global symbol "$foo" requires explicit package name at (re_eval 1) line 1.
 Compilation failed in regexp at - line 3.
 ########
+# Regex compilation errors weren't UTF-8 clean.
+use strict 'vars';
+use utf8;
+use open qw( :utf8 :std );
+qr/(?{$fòò++})/;
+EXPECT
+Global symbol "$fòò" requires explicit package name at (re_eval 1) line 1.
+Compilation failed in regexp at - line 5.
+########
 # [perl #73712] 'Variable is not imported' should be suppressible
 $dweck;
 use strict 'vars';

diff --git a/t/lib/warnings/gv b/t/lib/warnings/gv
index 42565f2..6101f69 100644 (file)
--- a/t/lib/warnings/gv
+++ b/t/lib/warnings/gv
@@ -17,7 +17,7 @@
   Mandatory Warnings ALL TODO
   ------------------
 
-    Had to create %s unexpectedly              [gv_fetchpv]
+    Had to create %SVf unexpectedly            [gv_fetchpv]
     Attempt to free unreferenced glob pointers [gp_free]
     
 __END__
@@ -43,6 +43,16 @@ EXPECT
 Use of inherited AUTOLOAD for non-method main::fred() is deprecated at - line 5.
 ########
 # gv.c
+use utf8;
+use open qw( :utf8 :std );
+sub Oᕞʀ::AUTOLOAD { 1 } sub Oᕞʀ::fᕃƌ {}
+@ISA = qw(Oᕞʀ) ;
+use warnings 'deprecated' ;
+fᕃƌ() ;
+EXPECT
+Use of inherited AUTOLOAD for non-method main::fᕃƌ() is deprecated at - line 7.
+########
+# gv.c
 $a = ${"#"};
 $a = ${"*"};
 no warnings 'deprecated' ;
@@ -51,3 +61,13 @@ $a = ${"*"};
 EXPECT
 $# is no longer supported at - line 2.
 $* is no longer supported at - line 3.
+########
+# gv.c
+use warnings 'syntax' ;
+use utf8;
+use open qw( :utf8 :std );
+package Ｙ;
+@ISA = qw(Fred); joe()
+EXPECT
+Can't locate package Fred for @Ｙ::ISA at - line 6.
+Undefined subroutine &Ｙ::joe called at - line 6.

diff --git a/t/lib/warnings/op b/t/lib/warnings/op
index a687686..12c38b9 100644 (file)
--- a/t/lib/warnings/op
+++ b/t/lib/warnings/op
@@ -533,6 +533,26 @@ Useless use of a constant (4) in void context at - line 6.
 Useless use of a constant (undef) in void context at - line 8.
 ########
 # op.c
+use utf8;
+use open qw( :utf8 :std );
+use warnings 'void' ;
+"àḆc"; # OP_CONST
+"Ẋ" . "ƴ"; # optimized to OP_CONST
+ＦＯＯ;     # Bareword optimized to OP_CONST
+use constant ů => undef;
+ů;
+5 || print "bad\n";    # test OPpCONST_SHORTCIRCUIT
+print "boo\n" if ů;   # test OPpCONST_SHORTCIRCUIT
+no warnings 'void' ;
+"àḆc"; # OP_CONST
+"Ẋ" . "ƴ"; # optimized to OP_CONST
+EXPECT
+Useless use of a constant (àḆc) in void context at - line 5.
+Useless use of a constant (Ẋƴ) in void context at - line 6.
+Useless use of a constant (ＦＯＯ) in void context at - line 7.
+Useless use of a constant (undef) in void context at - line 9.
+########
+# op.c
 #
 use warnings 'misc' ;
 my $a ; my @a = () ; my %a = () ; my $b = \@a ; my $c = \%a ;my $d = 'test';
@@ -1071,3 +1091,84 @@ $x = split /y/, "z";
      split /y/, "z";
 EXPECT
 Useless use of split in void context at - line 5.
+########
+# op.c
+use warnings 'redefine' ;
+use utf8;
+use open qw( :utf8 :std );
+sub frèd {}
+sub frèd {}
+no warnings 'redefine' ;
+sub frèd {}
+EXPECT
+Subroutine frèd redefined at - line 6.
+########
+# op.c
+use warnings 'redefine' ;
+use utf8;
+use open qw( :utf8 :std );
+sub frèd () { 1 }
+sub frèd () { 1 }
+no warnings 'redefine' ;
+sub frèd () { 1 }
+EXPECT
+Constant subroutine frèd redefined at - line 6.
+########
+# op.c
+no warnings 'redefine' ;
+use utf8;
+use open qw( :utf8 :std );
+sub frèd () { 1 }
+sub frèd () { 2 }
+EXPECT
+Constant subroutine frèd redefined at - line 6.
+########
+# op.c
+no warnings 'redefine' ;
+use utf8;
+use open qw( :utf8 :std );
+sub frèd () { 1 }
+*frèd = sub () { 2 };
+EXPECT
+Constant subroutine main::frèd redefined at - line 6.
+########
+# op.c
+use warnings 'redefine' ;
+use utf8;
+use open qw( :utf8 :std );
+sub ᚠርƊ {}
+sub ᚠርƊ {}
+no warnings 'redefine' ;
+sub ᚠርƊ {}
+EXPECT
+Subroutine ᚠርƊ redefined at - line 6.
+########
+# op.c
+use warnings 'redefine' ;
+use utf8;
+use open qw( :utf8 :std );
+sub ᚠርƊ () { 1 }
+sub ᚠርƊ () { 1 }
+no warnings 'redefine' ;
+sub ᚠርƊ () { 1 }
+EXPECT
+Constant subroutine ᚠርƊ redefined at - line 6.
+########
+# op.c
+no warnings 'redefine' ;
+use utf8;
+use open qw( :utf8 :std );
+sub ᚠርƊ () { 1 }
+sub ᚠርƊ () { 2 }
+EXPECT
+Constant subroutine ᚠርƊ redefined at - line 6.
+########
+# op.c
+no warnings 'redefine' ;
+use utf8;
+use open qw( :utf8 :std );
+sub ᚠርƊ () { 1 }
+*ᚠርƊ = sub () { 2 };
+EXPECT
+Constant subroutine main::ᚠርƊ redefined at - line 6.
+########