X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=XS.xs;h=db14fd525ecfbec52547bb2c68061a18a3c360ed;hb=6ed110b7fc5eb75d2ec95703dbbe7cba0f03b6dc;hp=19340c2bd99aeb475046ea2234e41d025ea53067;hpb=ff94166e91692aaaab9cc8b493cd753d88e56b2c;p=gitmo%2FClass-C3-XS.git diff --git a/XS.xs b/XS.xs index 19340c2..db14fd5 100644 --- a/XS.xs +++ b/XS.xs @@ -23,15 +23,15 @@ #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); @@ -251,7 +253,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; @@ -273,7 +277,7 @@ XS(XS_Class_C3_XS_nextcan) SV* self = ST(0); const I32 throw_nomethod = SvIVX(ST(1)); - register I32 cxix; + register I32 cxix = cxstack_ix; register const PERL_CONTEXT *ccstack = cxstack; const PERL_SI *top_si = PL_curstackinfo; HV* selfstash; @@ -296,6 +300,7 @@ XS(XS_Class_C3_XS_nextcan) HV* nmcache; HE* cache_entry; SV* cachekey; + I32 i; SP -= items; @@ -310,64 +315,65 @@ XS(XS_Class_C3_XS_nextcan) if (!hvname) Perl_croak(aTHX_ "Can't use anonymous symbol table for method lookup"); - cxix = __dopoptosub_at(cxstack, cxstack_ix); - cxix = __dopoptosub_at(ccstack, cxix - 1); /* skip next::method, etc */ - /* This block finds the contextually-enclosing fully-qualified subname, much like looking at (caller($i))[3] until you find a real sub that - isn't ANON, etc */ - for (;;) { - /* we may be in a higher stacklevel, so dig down deeper */ - while (cxix < 0) { - if(top_si->si_type == PERLSI_MAIN) - Perl_croak(aTHX_ "next::method/next::can/maybe::next::method must be used in method context"); - top_si = top_si->si_prev; - ccstack = top_si->si_cxstack; - cxix = __dopoptosub_at(ccstack, top_si->si_cxix); - } + isn't ANON, etc (also skips over pureperl next::method, etc) */ + for(i = 0; i < 2; i++) { + cxix = __dopoptosub_at(ccstack, cxix); + for (;;) { + /* we may be in a higher stacklevel, so dig down deeper */ + while (cxix < 0) { + if(top_si->si_type == PERLSI_MAIN) + Perl_croak(aTHX_ "next::method/next::can/maybe::next::method must be used in method context"); + top_si = top_si->si_prev; + ccstack = top_si->si_cxstack; + cxix = __dopoptosub_at(ccstack, top_si->si_cxix); + } - if(CxTYPE((PERL_CONTEXT*)(&ccstack[cxix])) != CXt_SUB - || (PL_DBsub && GvCV(PL_DBsub) && ccstack[cxix].blk_sub.cv == GvCV(PL_DBsub))) { - cxix = __dopoptosub_at(ccstack, cxix - 1); - continue; - } + if(CxTYPE((PERL_CONTEXT*)(&ccstack[cxix])) != CXt_SUB + || (PL_DBsub && GvCV(PL_DBsub) && ccstack[cxix].blk_sub.cv == GvCV(PL_DBsub))) { + cxix = __dopoptosub_at(ccstack, cxix - 1); + continue; + } - { - const I32 dbcxix = __dopoptosub_at(ccstack, cxix - 1); - if (PL_DBsub && GvCV(PL_DBsub) && dbcxix >= 0 && ccstack[dbcxix].blk_sub.cv == GvCV(PL_DBsub)) { - if(CxTYPE((PERL_CONTEXT*)(&ccstack[dbcxix])) != CXt_SUB) { - cxix = dbcxix; - continue; + { + const I32 dbcxix = __dopoptosub_at(ccstack, cxix - 1); + if (PL_DBsub && GvCV(PL_DBsub) && dbcxix >= 0 && ccstack[dbcxix].blk_sub.cv == GvCV(PL_DBsub)) { + if(CxTYPE((PERL_CONTEXT*)(&ccstack[dbcxix])) != CXt_SUB) { + cxix = dbcxix; + continue; + } } } - } - cvgv = CvGV(ccstack[cxix].blk_sub.cv); + cvgv = CvGV(ccstack[cxix].blk_sub.cv); - if(!isGV(cvgv)) { - cxix = __dopoptosub_at(ccstack, cxix - 1); - continue; - } + if(!isGV(cvgv)) { + cxix = __dopoptosub_at(ccstack, cxix - 1); + continue; + } - /* we found a real sub here */ - sv = sv_2mortal(newSV(0)); + /* we found a real sub here */ + sv = sv_2mortal(newSV(0)); - gv_efullname3(sv, cvgv, NULL); + gv_efullname3(sv, cvgv, NULL); - fq_subname = SvPVX(sv); - fq_subname_len = SvCUR(sv); + fq_subname = SvPVX(sv); + fq_subname_len = SvCUR(sv); - subname = strrchr(fq_subname, ':'); - if(!subname) - Perl_croak(aTHX_ "next::method/next::can/maybe::next::method cannot find enclosing method"); + subname = strrchr(fq_subname, ':'); + if(!subname) + Perl_croak(aTHX_ "next::method/next::can/maybe::next::method cannot find enclosing method"); - subname++; - subname_len = fq_subname_len - (subname - fq_subname); - if(subname_len == 8 && strEQ(subname, "__ANON__")) { - cxix = __dopoptosub_at(ccstack, cxix - 1); - continue; + subname++; + subname_len = fq_subname_len - (subname - fq_subname); + if(subname_len == 8 && strEQ(subname, "__ANON__")) { + cxix = __dopoptosub_at(ccstack, cxix - 1); + continue; + } + break; } - break; + cxix--; } /* If we made it to here, we found our context */ @@ -455,7 +461,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); } @@ -463,7 +471,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; @@ -553,10 +563,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(); @@ -575,7 +589,7 @@ XS(XS_Class_C3_XS_calc_mdt) } hv_iterinit(mro_stash); - while(he = hv_iternext(mro_stash)) { + while((he = hv_iternext(mro_stash))) { CV* code; SV* mskey; SV* msval; @@ -600,18 +614,28 @@ 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 BOOT: newXS("Class::C3::XS::calculateMRO", XS_Class_C3_XS_calculateMRO, __FILE__);