X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=universal.c;h=5c147b675a0233336a288a78fd687559c439ae26;hb=3246d7a3ad86dfa806dd7e514ae5fd2dacd5c0ef;hp=f8fa9cda88e4aed1ca4c9e9d3b103e95ac1844df;hpb=86c11942206ec09dd2a486bb22552aa2f170e322;p=p5sagit%2Fp5-mst-13.2.git diff --git a/universal.c b/universal.c index f8fa9cd..5c147b6 100644 --- a/universal.c +++ b/universal.c @@ -38,8 +38,8 @@ S_isa_lookup(pTHX_ HV *stash, const char *name, HV* name_stash, AV* av; GV* gv; GV** gvp; - HV* hv = Nullhv; - SV* subgen = Nullsv; + HV* hv = NULL; + SV* subgen = NULL; const char *hvname; /* A stash/class can go by many names (ie. User == main::User), so @@ -66,7 +66,7 @@ S_isa_lookup(pTHX_ HV *stash, const char *name, HV* name_stash, { if (SvIV(subgen) == (IV)PL_sub_generation) { SV* sv; - SV** svp = (SV**)hv_fetch(hv, name, len, FALSE); + SV** const svp = (SV**)hv_fetch(hv, name, len, FALSE); if (svp && (sv = *svp) != (SV*)&PL_sv_undef) { DEBUG_o( Perl_deb(aTHX_ "Using cached ISA %s for package %s\n", name, hvname) ); @@ -140,29 +140,29 @@ for class names as well as for objects. bool Perl_sv_derived_from(pTHX_ SV *sv, const char *name) { - const char *type = Nullch; - HV *stash = Nullhv; - HV *name_stash; + HV *stash; SvGETMAGIC(sv); if (SvROK(sv)) { + const char *type; sv = SvRV(sv); type = sv_reftype(sv,0); - if (SvOBJECT(sv)) - stash = SvSTASH(sv); + if (type && strEQ(type,name)) + return TRUE; + stash = SvOBJECT(sv) ? SvSTASH(sv) : NULL; } else { stash = gv_stashsv(sv, FALSE); } - name_stash = gv_stashpv(name, FALSE); + if (stash) { + HV * const name_stash = gv_stashpv(name, FALSE); + return isa_lookup(stash, name, name_stash, strlen(name), 0) == &PL_sv_yes; + } + else + return FALSE; - return (type && strEQ(type,name)) || - (stash && isa_lookup(stash, name, name_stash, strlen(name), 0) - == &PL_sv_yes) - ? TRUE - : FALSE ; } #include "XSUB.h" @@ -199,6 +199,7 @@ XS(XS_Regexp_DESTROY); XS(XS_Internals_hash_seed); XS(XS_Internals_rehash_seed); XS(XS_Internals_HvREHASH); +XS(XS_Internals_inc_sub_generation); void Perl_boot_core_UNIVERSAL(pTHX) @@ -247,6 +248,8 @@ Perl_boot_core_UNIVERSAL(pTHX) newXSproto("Internals::hash_seed",XS_Internals_hash_seed, file, ""); newXSproto("Internals::rehash_seed",XS_Internals_rehash_seed, file, ""); newXSproto("Internals::HvREHASH", XS_Internals_HvREHASH, file, "\\%"); + newXSproto("Internals::inc_sub_generation",XS_Internals_inc_sub_generation, + file, ""); } @@ -341,7 +344,7 @@ XS(XS_UNIVERSAL_VERSION) sv = nsv; if ( !sv_derived_from(sv, "version")) upg_version(sv); - undef = Nullch; + undef = NULL; } else { sv = (SV*)&PL_sv_undef; @@ -435,7 +438,7 @@ XS(XS_version_stringify) Perl_croak(aTHX_ "Usage: version::stringify(lobj, ...)"); SP -= items; { - SV * lobj = Nullsv; + SV * lobj; if (sv_derived_from(ST(0), "version")) { lobj = SvRV(ST(0)); @@ -457,7 +460,7 @@ XS(XS_version_numify) Perl_croak(aTHX_ "Usage: version::numify(lobj, ...)"); SP -= items; { - SV * lobj = Nullsv; + SV * lobj; if (sv_derived_from(ST(0), "version")) { lobj = SvRV(ST(0)); @@ -479,7 +482,7 @@ XS(XS_version_normal) Perl_croak(aTHX_ "Usage: version::normal(lobj, ...)"); SP -= items; { - SV * lobj = Nullsv; + SV * lobj; if (sv_derived_from(ST(0), "version")) { lobj = SvRV(ST(0)); @@ -501,7 +504,7 @@ XS(XS_version_vcmp) Perl_croak(aTHX_ "Usage: version::vcmp(lobj, ...)"); SP -= items; { - SV * lobj = Nullsv; + SV * lobj; if (sv_derived_from(ST(0), "version")) { lobj = SvRV(ST(0)); @@ -513,7 +516,7 @@ XS(XS_version_vcmp) SV *rs; SV *rvs; SV * robj = ST(1); - IV swap = (IV)SvIV(ST(2)); + const IV swap = (IV)SvIV(ST(2)); if ( ! sv_derived_from(robj, "version") ) { @@ -850,8 +853,8 @@ XS(XS_PerlIO_get_layers) if (!isGV(sv)) { if (SvROK(sv) && isGV(SvRV(sv))) gv = (GV*)SvRV(sv); - else - gv = gv_fetchsv(sv, FALSE, SVt_PVIO); + else if (SvPOKp(sv)) + gv = gv_fetchsv(sv, 0, SVt_PVIO); } if (gv && (io = GvIO(gv))) { @@ -949,6 +952,17 @@ XS(XS_Internals_HvREHASH) /* Subject to change */ Perl_croak(aTHX_ "Internals::HvREHASH $hashref"); } +XS(XS_Internals_inc_sub_generation) +{ + /* Using dXSARGS would also have dITEM and dSP, + * which define 2 unused local variables. */ + dAXMARK; + PERL_UNUSED_ARG(cv); + PERL_UNUSED_VAR(mark); + ++PL_sub_generation; + XSRETURN_EMPTY; +} + /* * Local variables: * c-indentation-style: bsd