X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=universal.c;h=6c118b7845a4da18a19cf85748cdb0e3f8b387d7;hb=345dbb93fc4813c4387eb6b1eedefc6d79a752d0;hp=e79bdae02cd7f397fdfb877f2974bed0ac4a3306;hpb=66610fdd5da795f6de595e815ccc4d1c9f3f4505;p=p5sagit%2Fp5-mst-13.2.git diff --git a/universal.c b/universal.c index e79bdae..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, @@ -137,13 +140,10 @@ for class names as well as for objects. bool Perl_sv_derived_from(pTHX_ SV *sv, const char *name) { - const char *type; - HV *stash; + const char *type = Nullch; + HV *stash = Nullhv; HV *name_stash; - stash = Nullhv; - type = Nullch; - if (SvGMAGICAL(sv)) mg_get(sv) ; @@ -176,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,19 +352,19 @@ XS(XS_UNIVERSAL_VERSION) } if (items > 1) { - STRLEN len; SV *req = ST(1); if (undef) { - if (pkg) - Perl_croak(aTHX_ - "%s does not define $%s::VERSION--version check failed", - HvNAME(pkg), HvNAME(pkg)); - else { - const char *str = SvPVx(ST(0), len); - - Perl_croak(aTHX_ - "%s defines neither package nor VERSION--version check failed", str); + if (pkg) { + const char *name = HvNAME_get(pkg); + Perl_croak(aTHX_ + "%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", + SvPVx(ST(0),n_a) ); } } @@ -374,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)); } @@ -420,7 +424,7 @@ XS(XS_version_stringify) Perl_croak(aTHX_ "Usage: version::stringify(lobj, ...)"); SP -= items; { - SV * lobj; + SV * lobj = Nullsv; if (sv_derived_from(ST(0), "version")) { SV *tmp = SvRV(ST(0)); @@ -443,7 +447,7 @@ XS(XS_version_numify) Perl_croak(aTHX_ "Usage: version::numify(lobj, ...)"); SP -= items; { - SV * lobj; + SV * lobj = Nullsv; if (sv_derived_from(ST(0), "version")) { SV *tmp = SvRV(ST(0)); @@ -466,7 +470,7 @@ XS(XS_version_vcmp) Perl_croak(aTHX_ "Usage: version::vcmp(lobj, ...)"); SP -= items; { - SV * lobj; + SV * lobj = Nullsv; if (sv_derived_from(ST(0), "version")) { SV *tmp = SvRV(ST(0)); @@ -511,7 +515,7 @@ XS(XS_version_boolean) Perl_croak(aTHX_ "Usage: version::boolean(lobj, ...)"); SP -= items; { - SV * lobj; + SV * lobj = Nullsv; if (sv_derived_from(ST(0), "version")) { /* XXX If tmp serves a purpose, explain it. */ @@ -534,25 +538,16 @@ XS(XS_version_boolean) XS(XS_version_noop) { - dXSARGS; - if (items < 1) - Perl_croak(aTHX_ "Usage: version::noop(lobj, ...)"); - { - SV * lobj; - - 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) @@ -562,7 +557,7 @@ XS(XS_version_is_alpha) Perl_croak(aTHX_ "Usage: version::is_alpha(lobj)"); SP -= items; { - SV *lobj; + SV * lobj = Nullsv; if (sv_derived_from(ST(0), "version")) { /* XXX If tmp serves a purpose, explain it. */ @@ -881,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 @@ -925,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); } @@ -933,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); } @@ -958,5 +955,5 @@ XS(XS_Internals_HvREHASH) /* Subject to change */ * indent-tabs-mode: t * End: * - * vim: ts=8 sts=4 sw=4 noet: -*/ + * ex: set ts=8 sts=4 sw=4 noet: + */