X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=universal.c;h=6c118b7845a4da18a19cf85748cdb0e3f8b387d7;hb=345dbb93fc4813c4387eb6b1eedefc6d79a752d0;hp=9383905fdf91ebb0c671cf99923f3c509c9332a2;hpb=abb2c24232c1dbd60ae39bdbb7e3cf487e3da996;p=p5sagit%2Fp5-mst-13.2.git diff --git a/universal.c b/universal.c index 9383905..6c118b7 100644 --- a/universal.c +++ b/universal.c @@ -40,13 +40,16 @@ S_isa_lookup(pTHX_ HV *stash, const char *name, HV* name_stash, GV** gvp; HV* hv = Nullhv; SV* subgen = Nullsv; + const char *hvname; /* A stash/class can go by many names (ie. User == main::User), so we compare the stash itself just in case */ if (name_stash && (stash == name_stash)) return &PL_sv_yes; - if (strEQ(HvNAME(stash), name)) + hvname = HvNAME_get(stash); + + if (strEQ(hvname, name)) return &PL_sv_yes; if (strEQ(name, "UNIVERSAL")) @@ -54,7 +57,7 @@ S_isa_lookup(pTHX_ HV *stash, const char *name, HV* name_stash, if (level > 100) Perl_croak(aTHX_ "Recursive inheritance detected in package '%s'", - HvNAME(stash)); + hvname); gvp = (GV**)hv_fetch(stash, "::ISA::CACHE::", 14, FALSE); @@ -66,13 +69,13 @@ S_isa_lookup(pTHX_ HV *stash, const char *name, HV* name_stash, SV** 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(stash)) ); + name, hvname) ); return sv; } } else { DEBUG_o( Perl_deb(aTHX_ "ISA Cache in package %s is stale\n", - HvNAME(stash)) ); + hvname) ); hv_clear(hv); sv_setiv(subgen, PL_sub_generation); } @@ -106,8 +109,8 @@ S_isa_lookup(pTHX_ HV *stash, const char *name, HV* name_stash, if (!basestash) { if (ckWARN(WARN_MISC)) Perl_warner(aTHX_ packWARN(WARN_SYNTAX), - "Can't locate package %"SVf" for @%s::ISA", - sv, HvNAME(stash)); + "Can't locate package %"SVf" for @%s::ISA", + sv, hvname); continue; } if (&PL_sv_yes == isa_lookup(basestash, name, name_stash, @@ -173,7 +176,11 @@ XS(XS_version_stringify); XS(XS_version_numify); XS(XS_version_vcmp); XS(XS_version_boolean); +#ifdef HASATTRIBUTE_NORETURN +XS(XS_version_noop) __attribute__noreturn__; +#else XS(XS_version_noop); +#endif XS(XS_version_is_alpha); XS(XS_version_qv); XS(XS_utf8_is_utf8); @@ -348,11 +355,12 @@ XS(XS_UNIVERSAL_VERSION) SV *req = ST(1); if (undef) { - if (pkg) + if (pkg) { + const char *name = HvNAME_get(pkg); Perl_croak(aTHX_ - "%s does not define $%s::VERSION--version check failed", - HvNAME(pkg), HvNAME(pkg)); - else { + "%s does not define $%s::VERSION--version check failed", + name, name); + } else { STRLEN n_a; Perl_croak(aTHX_ "%s defines neither package nor VERSION--version check failed", @@ -370,7 +378,7 @@ XS(XS_UNIVERSAL_VERSION) if ( vcmp( req, sv ) > 0 ) Perl_croak(aTHX_ "%s version %"SVf" (%"SVf") required--" - "this is only version %"SVf" (%"SVf")", HvNAME(pkg), + "this is only version %"SVf" (%"SVf")", HvNAME_get(pkg), vnumify(req),vnormal(req),vnumify(sv),vnormal(sv)); } @@ -530,25 +538,16 @@ XS(XS_version_boolean) XS(XS_version_noop) { - dXSARGS; - if (items < 1) - Perl_croak(aTHX_ "Usage: version::noop(lobj, ...)"); - { - SV * lobj = Nullsv; - - if (sv_derived_from(ST(0), "version")) { - SV *tmp = SvRV(ST(0)); - lobj = tmp; - } - else - Perl_croak(aTHX_ "lobj is not of type version"); - - { - Perl_croak(aTHX_ "operation not supported with version object"); - } - - } - XSRETURN_EMPTY; + dXSARGS; + if (items < 1) + Perl_croak(aTHX_ "Usage: version::noop(lobj, ...)"); + if (sv_derived_from(ST(0), "version")) + Perl_croak(aTHX_ "operation not supported with version object"); + else + Perl_croak(aTHX_ "lobj is not of type version"); +#ifndef HASATTRIBUTE_NORETURN + XSRETURN_EMPTY; +#endif } XS(XS_version_is_alpha) @@ -877,9 +876,9 @@ XS(XS_PerlIO_get_layers) if (details) { XPUSHs(namok ? - newSVpv(SvPVX(*namsvp), 0) : &PL_sv_undef); + newSVpv(SvPVX_const(*namsvp), 0) : &PL_sv_undef); XPUSHs(argok ? - newSVpv(SvPVX(*argsvp), 0) : &PL_sv_undef); + newSVpv(SvPVX_const(*argsvp), 0) : &PL_sv_undef); if (flgok) XPUSHi(SvIVX(*flgsvp)); else @@ -921,6 +920,7 @@ XS(XS_Internals_hash_seed) /* Using dXSARGS would also have dITEM and dSP, * which define 2 unused local variables. */ dAXMARK; + (void)mark; XSRETURN_UV(PERL_HASH_SEED); } @@ -929,6 +929,7 @@ XS(XS_Internals_rehash_seed) /* Using dXSARGS would also have dITEM and dSP, * which define 2 unused local variables. */ dAXMARK; + (void)mark; XSRETURN_UV(PL_rehash_seed); }