op.c: Malformed prototype warning on UTF8 sub name

diff --git a/op.c b/op.c
index 49c1513..7335747 100644 (file)
--- a/op.c
+++ b/op.c
@@ -9192,9 +9192,12 @@ Perl_ck_entersub_args_proto(pTHX_ OP *entersubop, GV *namegv, SV *protosv)
                proto++;
                continue;
            default:
-           oops:
-               Perl_croak(aTHX_ "Malformed prototype for %s: %"SVf,
-                       gv_ename(namegv), SVfARG(protosv));
+           oops: {
+                SV* const tmpsv = sv_newmortal();
+                gv_efullname3(tmpsv, namegv, NULL);
+               Perl_croak(aTHX_ "Malformed prototype for %"SVf": %"SVf,
+                       SVfARG(tmpsv), SVfARG(protosv));
+            }
        }
 
        op_lvalue(aop, OP_ENTERSUB);

diff --git a/t/uni/parser.t b/t/uni/parser.t
index 70b95fb..a939f9e 100644 (file)
--- a/t/uni/parser.t
+++ b/t/uni/parser.t
@@ -7,7 +7,7 @@ BEGIN {
     require './test.pl';
 }
 
-plan (tests => 35);
+plan (tests => 37);
 
 use utf8;
 use open qw( :utf8 :std );
@@ -89,6 +89,13 @@ sub 原 () { 1 }
 is grep({ $_ eq "\x{539f}"     } keys %::), 1, "Constant subs generate the right glob.";
 is grep({ $_ eq "\345\216\237" } keys %::), 0;
 
+#These should probably go elsewhere.
+eval q{ sub wròng1 (_$); wròng1(1,2) };
+like( $@, qr/Malformed prototype for main::wròng1/, 'Malformed prototype croak is clean.' );
+
+eval q{ sub ча::ики ($__); ча::ики(1,2) };
+like( $@, qr/Malformed prototype for ча::ики/ );
+
 TODO: {
     our $TODO = "our isn't clean in this branch";
     our $問 = 10;