mro.(c|xs): Make warnings utf8-clean

diff --git a/ext/mro/mro.xs b/ext/mro/mro.xs
index 618260e..1f099cb 100644 (file)
--- a/ext/mro/mro.xs
+++ b/ext/mro/mro.xs
@@ -45,8 +45,8 @@ S_mro_get_linear_isa_c3(pTHX_ HV* stash, U32 level)
       Perl_croak(aTHX_ "Can't linearize anonymous symbol table");
 
     if (level > 100)
-        Perl_croak(aTHX_ "Recursive inheritance detected in package '%s'",
-                  HEK_KEY(stashhek));
+        Perl_croak(aTHX_ "Recursive inheritance detected in package '%"SVf"'",
+                  SVfARG(sv_2mortal(newSVhek(stashhek))));
 
     meta = HvMROMETA(stash);
 
@@ -253,8 +253,10 @@ S_mro_get_linear_isa_c3(pTHX_ HV* stash, U32 level)
                 SV *errmsg;
                 I32 i;
 
-                errmsg = newSVpvf("Inconsistent hierarchy during C3 merge of class '%s':\n\t"
-                                  "current merge results [\n", HEK_KEY(stashhek));
+                errmsg = newSVpvf(
+                            "Inconsistent hierarchy during C3 merge of class '%"SVf"':\n\t"
+                            "current merge results [\n",
+                                            SVfARG(sv_2mortal(newSVhek(stashhek))));
                 for (i = 0; i <= av_len(retval); i++) {
                     SV **elem = av_fetch(retval, i, 0);
                     sv_catpvf(errmsg, "\t\t%"SVf",\n", SVfARG(*elem));
@@ -585,7 +587,10 @@ mro__nextcan(...)
            SV* const val = HeVAL(cache_entry);
            if(val == &PL_sv_undef) {
                if(throw_nomethod)
-                   Perl_croak(aTHX_ "No next::method '%s' found for %s", subname, hvname);
+                   Perl_croak(aTHX_ "No next::method '%"SVf"' found for %"SVf,
+                        SVfARG(newSVpvn_flags(subname, subname_len,
+                                SVs_TEMP | ( subname_utf8 ? SVf_UTF8 : 0 ) )),
+                        SVfARG(sv_2mortal(newSVhek( HvNAME_HEK(selfstash) ))));
                 XSRETURN_EMPTY;
            }
            mXPUSHs(newRV_inc(val));
@@ -629,8 +634,9 @@ mro__nextcan(...)
 
             if (!curstash) {
                 if (ckWARN(WARN_SYNTAX))
-                    Perl_warner(aTHX_ packWARN(WARN_SYNTAX), "Can't locate package %"SVf" for @%s::ISA",
-                        (void*)linear_sv, hvname);
+                    Perl_warner(aTHX_ packWARN(WARN_SYNTAX), "Can't locate package %"SVf" for @%"SVf"::ISA",
+                        (void*)linear_sv,
+                        SVfARG(sv_2mortal(newSVhek( HvNAME_HEK(selfstash) ))));
                 continue;
             }
 
@@ -661,7 +667,10 @@ mro__nextcan(...)
 
     (void)hv_store_ent(nmcache, sv, &PL_sv_undef, 0);
     if(throw_nomethod)
-        Perl_croak(aTHX_ "No next::method '%s' found for %s", subname, hvname);
+        Perl_croak(aTHX_ "No next::method '%"SVf"' found for %"SVf,
+                         SVfARG(newSVpvn_flags(subname, subname_len,
+                                SVs_TEMP | ( subname_utf8 ? SVf_UTF8 : 0 ) )),
+                        SVfARG(sv_2mortal(newSVhek( HvNAME_HEK(selfstash) ))));
     XSRETURN_EMPTY;
 
 BOOT:

diff --git a/mro.c b/mro.c
index c7f7538..d22b3ca 100644 (file)
--- a/mro.c
+++ b/mro.c
@@ -224,8 +224,8 @@ S_mro_get_linear_isa_dfs(pTHX_ HV *stash, U32 level)
       Perl_croak(aTHX_ "Can't linearize anonymous symbol table");
 
     if (level > 100)
-        Perl_croak(aTHX_ "Recursive inheritance detected in package '%s'",
-                  HEK_KEY(stashhek));
+        Perl_croak(aTHX_ "Recursive inheritance detected in package '%"SVf"'",
+                  SVfARG(sv_2mortal(newSVhek(stashhek))));
 
     meta = HvMROMETA(stash);
 

diff --git a/t/mro/next_skip_utf8.t b/t/mro/next_skip_utf8.t
index 9dd4659..64e7745 100644 (file)
--- a/t/mro/next_skip_utf8.t
+++ b/t/mro/next_skip_utf8.t
@@ -68,11 +68,8 @@ is(Ｄiᚪၚd_D->ᕘ, 'Ｄiᚪၚd_D::ᕘ => Ｄiᚪၚd_C::ᕘ', '... skipped
 is(Ｄiᚪၚd_D->ᴮaȐ, 'Ｄiᚪၚd_D::ᴮaȐ => Ｄiᚪၚd_A::ᴮaȐ', '... skipped B & C and went to A correctly');
 is(Ｄiᚪၚd_D->바ź, 'Ｄiᚪၚd_B::바ź => Ｄiᚪၚd_A::바ź', '... called B method, skipped C and went to A correctly');
 is(Ｄiᚪၚd_D->buƵ, 'Ｄiᚪၚd_D::buƵ => Ｄiᚪၚd_B::바ź => Ｄiᚪၚd_A::바ź', '... called D method dispatched to , different method correctly');
-TODO: {
-    local our $TODO = "Warnings aren't clean yet";
-    eval { Ｄiᚪၚd_D->fuz };
-    like($@, qr/^No next::method 'fuz' found for Ｄiᚪၚd_D/u, '... cannot re-dispatch to a method which is not there');
-}
+eval { Ｄiᚪၚd_D->fuz };
+like($@, qr/^No next::method 'fuz' found for Ｄiᚪၚd_D/u, '... cannot re-dispatch to a method which is not there');
 is(Ｄiᚪၚd_D->woｚ, 'Ｄiᚪၚd_D::woｚ can => 1', '... can re-dispatch figured out correctly');
 is(Ｄiᚪၚd_D->noz, 'Ｄiᚪၚd_D::noz can => 0', '... cannot re-dispatch figured out correctly');