Make newXS redefinition warning respect UTF8

diff --git a/ext/XS-APItest/t/newCONSTSUB.t b/ext/XS-APItest/t/newCONSTSUB.t
index 286f9a2..b6e672d 100644 (file)
--- a/ext/XS-APItest/t/newCONSTSUB.t
+++ b/ext/XS-APItest/t/newCONSTSUB.t
@@ -4,7 +4,7 @@ use strict;
 use warnings;
 use utf8;
 use open qw( :utf8 :std );
-use Test::More tests => 9;
+use Test::More tests => 11;
 
 use XS::APItest;
 
@@ -33,3 +33,17 @@ eval q{
   is $w, undef, 'newCONSTSUB uses calling scope for redefinition warnings';
  }
 };
+
+{
+ no strict 'refs';
+ *{"foo::\x{100}"} = sub(){return 123};
+ my $w;
+ local $SIG{__WARN__} = sub { $w .= shift };
+ newCONSTSUB_type(\%foo::, "\x{100}", 0, 1);
+ like $w, qr/Subroutine \x{100} redefined at /,
+   'newCONSTSUB redefinition warning + utf8';
+ undef $w;
+ newCONSTSUB_type(\%foo::, "\x{100}", 0, 1);
+ like $w, qr/Constant subroutine \x{100} redefined at /,
+   'newCONSTSUB constant redefinition warning + utf8';
+}

diff --git a/op.c b/op.c
index a17dce2..97407ad 100644 (file)
--- a/op.c
+++ b/op.c
@@ -7030,9 +7030,12 @@ Perl_newXS_len_flags(pTHX_ const char *name, STRLEN len,
                         CopLINE_set(PL_curcop, PL_parser->copline);
                     Perl_warner(aTHX_ packWARN(WARN_REDEFINE),
                                       CvCONST(cv)
-                                       ? "Constant subroutine %s redefined"
-                                       : "Subroutine %s redefined"
-                                     ,name);
+                                       ? "Constant subroutine %"SVf
+                                         " redefined"
+                                       : "Subroutine %"SVf" redefined",
+                                      newSVpvn_flags(
+                                         name,len,(flags&SVf_UTF8)|SVs_TEMP
+                                      ));
                     CopLINE_set(PL_curcop, oldline);
                 }
              nope: