Improve mro merging error messages.
[gitmo/Class-C3-XS.git] / XS.xs
diff --git a/XS.xs b/XS.xs
index 615ae10..94ba2d8 100644 (file)
--- a/XS.xs
+++ b/XS.xs
 
 #ifndef SvREFCNT_inc
 #  ifdef PERL_USE_GCC_BRACE_GROUPS
-#    define SvREFCNT_inc(sv)           \
-      ({                               \
-          SV * const _sv = (SV*)(sv);  \
-          if (_sv)                     \
-               (SvREFCNT(_sv))++;      \
-          _sv;                         \
+#    define SvREFCNT_inc(sv) \
+      ({ \
+          SV * const _sv = (SV*)(sv); \
+          if (_sv) \
+               (SvREFCNT(_sv))++; \
+          _sv; \
       })
 #  else
-#    define SvREFCNT_inc(sv)   \
+#    define SvREFCNT_inc(sv) \
           ((PL_Sv=(SV*)(sv)) ? (++(SvREFCNT(PL_Sv)),PL_Sv) : NULL)
 #  endif
 #endif
@@ -144,7 +144,9 @@ __mro_linear_isa_c3(pTHX_ HV* stash, HV* cache, I32 level)
                     SV* const seqitem = *seq_ptr++;
                     HE* const he = hv_fetch_ent(tails, seqitem, 0, 0);
                     if(!he) {
-                        hv_store_ent(tails, seqitem, newSViv(1), 0);
+                        if(!hv_store_ent(tails, seqitem, newSViv(1), 0)) {
+                            croak("failed to store value in hash");
+                        }
                     }
                     else {
                         SV* const val = HeVAL(he);
@@ -229,13 +231,22 @@ __mro_linear_isa_c3(pTHX_ HV* stash, HV* cache, I32 level)
             /* If we had candidates, but nobody won, then the @ISA
                hierarchy is not C3-incompatible */
             if(!winner) {
+                SV *errmsg;
+                I32 i;
                 /* we have to do some cleanup before we croak */
 
+                errmsg = newSVpvf("Inconsistent hierarchy during C3 merge of class '%s':\n\t"
+                                  "current merge results [\n", stashname);
+                for (i = 0; i <= av_len(retval); i++) {
+                    SV **elem = av_fetch(retval, i, 0);
+                    sv_catpvf(errmsg, "\t\t%"SVf",\n", SVfARG(*elem));
+                }
+                sv_catpvf(errmsg, "\t]\n\tmerging failed on '%"SVf"'", SVfARG(cand));
+
                 SvREFCNT_dec(retval);
                 Safefree(heads);
 
-                Perl_croak(aTHX_ "Inconsistent hierarchy during C3 merge of class '%s': "
-                    "merging failed on parent '%s'", stashname, SvPV_nolen(cand));
+                croak("%"SVf, SVfARG(errmsg));
             }
         }
     }
@@ -251,7 +262,9 @@ __mro_linear_isa_c3(pTHX_ HV* stash, HV* cache, I32 level)
 
     if(!made_mortal_cache) {
         SvREFCNT_inc(retval);
-        hv_store(cache, stashname, stashname_len, (SV*)retval, 0);
+        if(!hv_store(cache, stashname, stashname_len, (SV*)retval, 0)) {
+            croak("failed to store value in hash");
+        }
     }
 
     return retval;
@@ -457,7 +470,9 @@ XS(XS_Class_C3_XS_nextcan)
             if (SvTYPE(candidate) == SVt_PVGV && (cand_cv = GvCV(candidate)) && !GvCVGEN(candidate)) {
                 SvREFCNT_dec(linear_av);
                 SvREFCNT_inc((SV*)cand_cv);
-                hv_store_ent(nmcache, newSVsv(cachekey), (SV*)cand_cv, 0);
+                if (!hv_store_ent(nmcache, newSVsv(cachekey), (SV*)cand_cv, 0)) {
+                    croak("failed to store value in hash");
+                }
                 XPUSHs(sv_2mortal(newRV_inc((SV*)cand_cv)));
                 XSRETURN(1);
             }
@@ -465,7 +480,9 @@ XS(XS_Class_C3_XS_nextcan)
     }
 
     SvREFCNT_dec(linear_av);
-    hv_store_ent(nmcache, newSVsv(cachekey), &PL_sv_undef, 0);
+    if (!hv_store_ent(nmcache, newSVsv(cachekey), &PL_sv_undef, 0)) {
+        croak("failed to store value in hash");
+    }
     if(throw_nomethod)
         Perl_croak(aTHX_ "No next::method '%s' found for %s", subname, hvname);
     XSRETURN_EMPTY;
@@ -555,10 +572,14 @@ XS(XS_Class_C3_XS_calc_mdt)
     class_mro = __mro_linear_isa_c3(aTHX_ class_stash, cache, 0);
 
     our_c3mro = newHV();
-    hv_store(our_c3mro, "MRO", 3, (SV*)newRV_noinc((SV*)class_mro), 0);
+    if(!hv_store(our_c3mro, "MRO", 3, (SV*)newRV_noinc((SV*)class_mro), 0)) {
+        croak("failed to store value in hash");
+    }
 
     hv = get_hv("Class::C3::MRO", 1);
-    hv_store_ent(hv, classname, (SV*)newRV_noinc((SV*)our_c3mro), 0);
+    if(!hv_store_ent(hv, classname, (SV*)newRV_noinc((SV*)our_c3mro), 0)) {
+        croak("failed to store value in hash");
+    }
 
     methods = newHV();
 
@@ -602,18 +623,26 @@ XS(XS_Class_C3_XS_calc_mdt)
             orig = newSVsv(mro_class);
             sv_catpvn(orig, "::", 2);
             sv_catsv(orig, mskey);
-            hv_store(meth_hash, "orig", 4, orig, 0);
-            hv_store(meth_hash, "code", 4, newRV_inc((SV*)code), 0);
-            hv_store_ent(methods, mskey, newRV_noinc((SV*)meth_hash), 0);
+            if( !hv_store(meth_hash, "orig", 4, orig, 0)
+             || !hv_store(meth_hash, "code", 4, newRV_inc((SV*)code), 0)
+             || !hv_store_ent(methods, mskey, newRV_noinc((SV*)meth_hash), 0) ) {
+                croak("failed to store value in hash");
+            }
         }
     }
 
-    hv_store(our_c3mro, "methods", 7, newRV_noinc((SV*)methods), 0);
-    if(has_ovf) hv_store(our_c3mro, "has_overload_fallback", 21, SvREFCNT_inc(has_ovf), 0);
+    if(!hv_store(our_c3mro, "methods", 7, newRV_noinc((SV*)methods), 0)) {
+        croak("failed to store value in hash");
+    }
+    if(has_ovf) {
+        if(!hv_store(our_c3mro, "has_overload_fallback", 21, SvREFCNT_inc(has_ovf), 0)) {
+            croak("failed to store value in hash");
+        }
+    }
     XSRETURN_EMPTY;
 }
 
-MODULE = Class::C3::XS PACKAGE = Class::C3::XS
+MODULE = Class::C3::XS  PACKAGE = Class::C3::XS
 
 PROTOTYPES: DISABLED