X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=universal.c;h=fa0ccd309b5536d50376a472c1d4ecbff7358096;hb=130fdcc93ad3c25c64febb23ca35708cbb56d231;hp=36b9807b179c665caf5b9ad49039bb0ea1953936;hpb=48fc47360d542e9af53b5df6c7a018fe428c613c;p=p5sagit%2Fp5-mst-13.2.git diff --git a/universal.c b/universal.c index 36b9807..fa0ccd3 100644 --- a/universal.c +++ b/universal.c @@ -161,7 +161,7 @@ Perl_sv_does(pTHX_ SV *sv, const char *name) XPUSHs(sv_2mortal(newSVpv(name, 0))); PUTBACK; - methodname = sv_2mortal(newSVpv("isa", 0)); + methodname = sv_2mortal(newSVpvs("isa")); /* ugly hack: use the SvSCREAM flag so S_method_common * can figure out we're calling DOES() and not isa(), * and report eventual errors correctly. --rgs */ @@ -176,26 +176,6 @@ Perl_sv_does(pTHX_ SV *sv, const char *name) return does_it; } -regexp * -Perl_get_re_arg( pTHX_ SV *sv, U32 flags, MAGIC **mgp) { - MAGIC *mg; - if (sv) { - if (SvMAGICAL(sv)) - mg_get(sv); - if (SvROK(sv) && - (sv = (SV*)SvRV(sv)) && /* assign deliberate */ - SvTYPE(sv) == SVt_PVMG && - (mg = mg_find(sv, PERL_MAGIC_qr))) /* assign deliberate */ - { - if (mgp) *mgp = mg; - return (regexp *)mg->mg_obj; - } - } - if (mgp) *mgp = NULL; - return ((flags && PL_curpm) ? PM_GETRE(PL_curpm) : NULL); -} - - PERL_XS_EXPORT_C void XS_UNIVERSAL_isa(pTHX_ CV *cv); PERL_XS_EXPORT_C void XS_UNIVERSAL_can(pTHX_ CV *cv); PERL_XS_EXPORT_C void XS_UNIVERSAL_DOES(pTHX_ CV *cv); @@ -239,8 +219,8 @@ XS(XS_Tie_Hash_NamedCapture_STORE); XS(XS_Tie_Hash_NamedCapture_DELETE); XS(XS_Tie_Hash_NamedCapture_CLEAR); XS(XS_Tie_Hash_NamedCapture_EXISTS); -XS(XS_Tie_Hash_NamedCapture_FIRSTKEY); -XS(XS_Tie_Hash_NamedCapture_NEXTKEY); +XS(XS_Tie_Hash_NamedCapture_FIRSTK); +XS(XS_Tie_Hash_NamedCapture_NEXTK); XS(XS_Tie_Hash_NamedCapture_SCALAR); XS(XS_Tie_Hash_NamedCapture_flags); @@ -302,8 +282,8 @@ Perl_boot_core_UNIVERSAL(pTHX) newXS("Tie::Hash::NamedCapture::DELETE", XS_Tie_Hash_NamedCapture_DELETE, file); newXS("Tie::Hash::NamedCapture::CLEAR", XS_Tie_Hash_NamedCapture_CLEAR, file); newXS("Tie::Hash::NamedCapture::EXISTS", XS_Tie_Hash_NamedCapture_EXISTS, file); - newXS("Tie::Hash::NamedCapture::FIRSTKEY", XS_Tie_Hash_NamedCapture_FIRSTKEY, file); - newXS("Tie::Hash::NamedCapture::NEXTKEY", XS_Tie_Hash_NamedCapture_NEXTKEY, file); + newXS("Tie::Hash::NamedCapture::FIRSTKEY", XS_Tie_Hash_NamedCapture_FIRSTK, file); + newXS("Tie::Hash::NamedCapture::NEXTKEY", XS_Tie_Hash_NamedCapture_NEXTK, file); newXS("Tie::Hash::NamedCapture::SCALAR", XS_Tie_Hash_NamedCapture_SCALAR, file); newXS("Tie::Hash::NamedCapture::flags", XS_Tie_Hash_NamedCapture_flags, file); } @@ -1075,22 +1055,17 @@ XS(XS_re_is_regexp) { dVAR; dXSARGS; + PERL_UNUSED_VAR(cv); + if (items != 1) Perl_croak(aTHX_ "Usage: %s(%s)", "re::is_regexp", "sv"); - PERL_UNUSED_VAR(cv); /* -W */ - PERL_UNUSED_VAR(ax); /* -Wall */ + SP -= items; - { - SV * sv = ST(0); - if ( Perl_get_re_arg( aTHX_ sv, 0, NULL ) ) - { - XSRETURN_YES; - } else { - XSRETURN_NO; - } - /* NOTREACHED */ - PUTBACK; - return; + + if (SvRXOK(ST(0))) { + XSRETURN_YES; + } else { + XSRETURN_NO; } } @@ -1143,11 +1118,11 @@ XS(XS_re_regname) XSRETURN_UNDEF; if (items == 2 && SvTRUE(ST(1))) { - flags = RXf_HASH_ALL; + flags = RXapif_ALL; } else { - flags = RXf_HASH_ONE; + flags = RXapif_ONE; } - ret = CALLREG_NAMED_BUFF_FETCH(rx, ST(0), (flags | RXf_HASH_REGNAME)); + ret = CALLREG_NAMED_BUFF_FETCH(rx, ST(0), (flags | RXapif_REGNAME)); if (ret) { if (SvROK(ret)) @@ -1182,14 +1157,14 @@ XS(XS_re_regnames) XSRETURN_UNDEF; if (items == 1 && SvTRUE(ST(0))) { - flags = RXf_HASH_ALL; + flags = RXapif_ALL; } else { - flags = RXf_HASH_ONE; + flags = RXapif_ONE; } SP -= items; - ret = CALLREG_NAMED_BUFF_ALL(rx, (flags | RXf_HASH_REGNAMES)); + ret = CALLREG_NAMED_BUFF_ALL(rx, (flags | RXapif_REGNAMES)); SPAGAIN; @@ -1345,7 +1320,7 @@ XS(XS_Tie_Hash_NamedCapture_EXISTS) return; } -XS(XS_Tie_Hash_NamedCapture_FIRSTKEY) +XS(XS_Tie_Hash_NamedCapture_FIRSTK) { dVAR; dXSARGS; @@ -1378,7 +1353,7 @@ XS(XS_Tie_Hash_NamedCapture_FIRSTKEY) } -XS(XS_Tie_Hash_NamedCapture_NEXTKEY) +XS(XS_Tie_Hash_NamedCapture_NEXTK) { dVAR; dXSARGS; @@ -1452,8 +1427,8 @@ XS(XS_Tie_Hash_NamedCapture_flags) if (items != 0) Perl_croak(aTHX_ "Usage: Tie::Hash::NamedCapture::flags()"); - XPUSHs(sv_2mortal(newSVuv(RXf_HASH_ONE))); - XPUSHs(sv_2mortal(newSVuv(RXf_HASH_ALL))); + XPUSHs(sv_2mortal(newSVuv(RXapif_ONE))); + XPUSHs(sv_2mortal(newSVuv(RXapif_ALL))); PUTBACK; return; }