PUSHMARK(SP);
XPUSHs(sv);
- XPUSHs(sv_2mortal(newSVpv(name, 0)));
+ mXPUSHs(newSVpv(name, 0));
PUTBACK;
- methodname = sv_2mortal(newSVpv("isa", 0));
+ methodname = newSVpvs_flags("isa", SVs_TEMP);
/* 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 */
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);
XS(XS_Internals_SvREFCNT);
XS(XS_Internals_hv_clear_placehold);
XS(XS_PerlIO_get_layers);
-XS(XS_Regexp_DESTROY);
XS(XS_Internals_hash_seed);
XS(XS_Internals_rehash_seed);
XS(XS_Internals_HvREHASH);
XS_Internals_hv_clear_placehold, file, "\\%");
newXSproto("PerlIO::get_layers",
XS_PerlIO_get_layers, file, "*;@");
- newXS("Regexp::DESTROY", XS_Regexp_DESTROY, file);
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, "\\%");
if ( strcmp(classname,"version") != 0 ) /* inherited new() */
sv_bless(rv, gv_stashpv(classname, GV_ADD));
- PUSHs(sv_2mortal(rv));
+ mPUSHs(rv);
PUTBACK;
return;
}
else
Perl_croak(aTHX_ "lobj is not of type version");
- PUSHs(sv_2mortal(vstringify(lobj)));
+ mPUSHs(vstringify(lobj));
PUTBACK;
return;
else
Perl_croak(aTHX_ "lobj is not of type version");
- PUSHs(sv_2mortal(vnumify(lobj)));
+ mPUSHs(vnumify(lobj));
PUTBACK;
return;
else
Perl_croak(aTHX_ "lobj is not of type version");
- PUSHs(sv_2mortal(vnormal(lobj)));
+ mPUSHs(vnormal(lobj));
PUTBACK;
return;
rs = newSViv(vcmp(lobj,rvs));
}
- PUSHs(sv_2mortal(rs));
+ mPUSHs(rs);
}
PUTBACK;
if (sv_derived_from(ST(0), "version")) {
SV * const lobj = SvRV(ST(0));
SV * const rs = newSViv( vcmp(lobj,new_version(newSVpvs("0"))) );
- PUSHs(sv_2mortal(rs));
+ mPUSHs(rs);
PUTBACK;
return;
}
}
else
{
- PUSHs(sv_2mortal(new_version(ver)));
+ mPUSHs(new_version(ver));
}
PUTBACK;
}
}
-XS(XS_Regexp_DESTROY)
-{
- PERL_UNUSED_CONTEXT;
- PERL_UNUSED_ARG(cv);
-}
-
XS(XS_PerlIO_get_layers)
{
dVAR;
}
if (gv && (io = GvIO(gv))) {
- dTARGET;
AV* const av = PerlIO_get_layers(aTHX_ input ?
IoIFP(io) : IoOFP(io));
I32 i;
if (details) {
XPUSHs(namok
- ? newSVpvn(SvPVX_const(*namsvp), SvCUR(*namsvp))
+ ? sv_2mortal(newSVpvn(SvPVX_const(*namsvp), SvCUR(*namsvp)))
: &PL_sv_undef);
XPUSHs(argok
- ? newSVpvn(SvPVX_const(*argsvp), SvCUR(*argsvp))
+ ? sv_2mortal(newSVpvn(SvPVX_const(*argsvp), SvCUR(*argsvp)))
: &PL_sv_undef);
if (flgok)
- XPUSHi(SvIVX(*flgsvp));
+ mXPUSHi(SvIVX(*flgsvp));
else
XPUSHs(&PL_sv_undef);
nitem += 3;
}
else {
if (namok && argok)
- XPUSHs(Perl_newSVpvf(aTHX_ "%"SVf"(%"SVf")",
+ XPUSHs(sv_2mortal(Perl_newSVpvf(aTHX_ "%"SVf"(%"SVf")",
SVfARG(*namsvp),
- SVfARG(*argsvp)));
+ SVfARG(*argsvp))));
else if (namok)
- XPUSHs(Perl_newSVpvf(aTHX_ "%"SVf,
- SVfARG(*namsvp)));
+ XPUSHs(sv_2mortal(Perl_newSVpvf(aTHX_ "%"SVf,
+ SVfARG(*namsvp))));
else
XPUSHs(&PL_sv_undef);
nitem++;
const IV flags = SvIVX(*flgsvp);
if (flags & PERLIO_F_UTF8) {
- XPUSHs(newSVpvs("utf8"));
+ XPUSHs(newSVpvs_flags("utf8", SVs_TEMP));
nitem++;
}
}
{
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;
}
}
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))
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;
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)));
+ mXPUSHu(RXapif_ONE);
+ mXPUSHu(RXapif_ALL);
PUTBACK;
return;
}