diff options
author | Michael G. Schwern <schwern@pobox.com> | 2020-12-28 18:04:52 -0800 |
---|---|---|
committer | Karl Williamson <khw@cpan.org> | 2021-01-17 09:18:15 -0700 |
commit | 1604cfb0273418ed479719f39def5ee559bffda2 (patch) | |
tree | 166a5ab935a029ab86cf6295d6f3cb77da22e559 /universal.c | |
parent | 557ff1b2a4ecd18fe9229e7e0eb8fa123adc5670 (diff) | |
download | perl-1604cfb0273418ed479719f39def5ee559bffda2.tar.gz |
style: Detabify indentation of the C code maintained by the core.
This just detabifies to get rid of the mixed tab/space indentation.
Applying consistent indentation and dealing with other tabs are another issue.
Done with `expand -i`.
* vutil.* left alone, it's part of version.
* Left regen managed files alone for now.
Diffstat (limited to 'universal.c')
-rw-r--r-- | universal.c | 612 |
1 files changed, 306 insertions, 306 deletions
diff --git a/universal.c b/universal.c index 9c49cd8327..c459064a6c 100644 --- a/universal.c +++ b/universal.c @@ -53,14 +53,14 @@ S_isa_lookup(pTHX_ HV *stash, SV *namesv, const char * name, STRLEN len, U32 fla PERL_ARGS_ASSERT_ISA_LOOKUP; if (!isa) { - (void)mro_get_linear_isa(stash); - isa = meta->isa; + (void)mro_get_linear_isa(stash); + isa = meta->isa; } if (hv_common(isa, namesv, name, len, ( flags & SVf_UTF8 ? HVhek_UTF8 : 0), - HV_FETCH_ISEXISTS, NULL, 0)) { - /* Direct name lookup worked. */ - return TRUE; + HV_FETCH_ISEXISTS, NULL, 0)) { + /* Direct name lookup worked. */ + return TRUE; } /* A stash/class can go by many names (ie. User == main::User), so @@ -69,14 +69,14 @@ S_isa_lookup(pTHX_ HV *stash, SV *namesv, const char * name, STRLEN len, U32 fla our_stash = gv_stashsvpvn_cached(namesv, name, len, flags); if (our_stash) { - HEK *canon_name = HvENAME_HEK(our_stash); - if (!canon_name) canon_name = HvNAME_HEK(our_stash); - assert(canon_name); - if (hv_common(isa, NULL, HEK_KEY(canon_name), HEK_LEN(canon_name), - HEK_FLAGS(canon_name), - HV_FETCH_ISEXISTS, NULL, HEK_HASH(canon_name))) { - return TRUE; - } + HEK *canon_name = HvENAME_HEK(our_stash); + if (!canon_name) canon_name = HvNAME_HEK(our_stash); + assert(canon_name); + if (hv_common(isa, NULL, HEK_KEY(canon_name), HEK_LEN(canon_name), + HEK_FLAGS(canon_name), + HV_FETCH_ISEXISTS, NULL, HEK_HASH(canon_name))) { + return TRUE; + } } return FALSE; @@ -285,19 +285,19 @@ Perl_sv_does_sv(pTHX_ SV *sv, SV *namesv, U32 flags) SvGETMAGIC(sv); if (!SvOK(sv) || !(SvROK(sv) || (SvPOK(sv) && SvCUR(sv)))) { - LEAVE; - return FALSE; + LEAVE; + return FALSE; } if (SvROK(sv) && SvOBJECT(SvRV(sv))) { - classname = sv_ref(NULL,SvRV(sv),TRUE); + classname = sv_ref(NULL,SvRV(sv),TRUE); } else { - classname = sv; + classname = sv; } if (sv_eq(classname, namesv)) { - LEAVE; - return TRUE; + LEAVE; + return TRUE; } PUSHMARK(SP); @@ -396,25 +396,25 @@ Perl_croak_xs_usage(const CV *const cv, const char *const params) PERL_ARGS_ASSERT_CROAK_XS_USAGE; if (gv) got_gv: { - const HV *const stash = GvSTASH(gv); + const HV *const stash = GvSTASH(gv); - if (HvNAME_get(stash)) - /* diag_listed_as: SKIPME */ - Perl_croak_nocontext("Usage: %" HEKf "::%" HEKf "(%s)", + if (HvNAME_get(stash)) + /* diag_listed_as: SKIPME */ + Perl_croak_nocontext("Usage: %" HEKf "::%" HEKf "(%s)", HEKfARG(HvNAME_HEK(stash)), HEKfARG(GvNAME_HEK(gv)), params); - else - /* diag_listed_as: SKIPME */ - Perl_croak_nocontext("Usage: %" HEKf "(%s)", + else + /* diag_listed_as: SKIPME */ + Perl_croak_nocontext("Usage: %" HEKf "(%s)", HEKfARG(GvNAME_HEK(gv)), params); } else { dTHX; if ((gv = CvGV(cv))) goto got_gv; - /* Pants. I don't think that it should be possible to get here. */ - /* diag_listed_as: SKIPME */ - Perl_croak(aTHX_ "Usage: CODE(0x%" UVxf ")(%s)", PTR2UV(cv), params); + /* Pants. I don't think that it should be possible to get here. */ + /* diag_listed_as: SKIPME */ + Perl_croak(aTHX_ "Usage: CODE(0x%" UVxf ")(%s)", PTR2UV(cv), params); } } @@ -424,17 +424,17 @@ XS(XS_UNIVERSAL_isa) dXSARGS; if (items != 2) - croak_xs_usage(cv, "reference, kind"); + croak_xs_usage(cv, "reference, kind"); else { - SV * const sv = ST(0); + SV * const sv = ST(0); - SvGETMAGIC(sv); + SvGETMAGIC(sv); - if (!SvOK(sv) || !(SvROK(sv) || (SvPOK(sv) && SvCUR(sv)))) - XSRETURN_UNDEF; + if (!SvOK(sv) || !(SvROK(sv) || (SvPOK(sv) && SvCUR(sv)))) + XSRETURN_UNDEF; - ST(0) = boolSV(sv_derived_from_sv(sv, ST(1), 0)); - XSRETURN(1); + ST(0) = boolSV(sv_derived_from_sv(sv, ST(1), 0)); + XSRETURN(1); } } @@ -448,7 +448,7 @@ XS(XS_UNIVERSAL_can) GV *iogv; if (items != 2) - croak_xs_usage(cv, "object-ref, method"); + croak_xs_usage(cv, "object-ref, method"); sv = ST(0); @@ -458,7 +458,7 @@ XS(XS_UNIVERSAL_can) precedence here over the numeric form, as (!1)->foo treats the invocant as the empty string, though it is a dualvar. */ if (!SvOK(sv) || (SvPOK(sv) && !SvCUR(sv))) - XSRETURN_UNDEF; + XSRETURN_UNDEF; rv = &PL_sv_undef; @@ -467,7 +467,7 @@ XS(XS_UNIVERSAL_can) if (SvOBJECT(sv)) pkg = SvSTASH(sv); else if (isGV_with_GP(sv) && GvIO(sv)) - pkg = SvSTASH(GvIO(sv)); + pkg = SvSTASH(GvIO(sv)); } else if (isGV_with_GP(sv) && GvIO(sv)) pkg = SvSTASH(GvIO(sv)); @@ -480,9 +480,9 @@ XS(XS_UNIVERSAL_can) } if (pkg) { - GV * const gv = gv_fetchmethod_sv_flags(pkg, ST(1), 0); + GV * const gv = gv_fetchmethod_sv_flags(pkg, ST(1), 0); if (gv && isGV(gv)) - rv = sv_2mortal(newRV(MUTABLE_SV(GvCV(gv)))); + rv = sv_2mortal(newRV(MUTABLE_SV(GvCV(gv)))); } ST(0) = rv; @@ -496,13 +496,13 @@ XS(XS_UNIVERSAL_DOES) PERL_UNUSED_ARG(cv); if (items != 2) - Perl_croak(aTHX_ "Usage: invocant->DOES(kind)"); + Perl_croak(aTHX_ "Usage: invocant->DOES(kind)"); else { - SV * const sv = ST(0); - if (sv_does_sv( sv, ST(1), 0 )) - XSRETURN_YES; + SV * const sv = ST(0); + if (sv_does_sv( sv, ST(1), 0 )) + XSRETURN_YES; - XSRETURN_NO; + XSRETURN_NO; } } @@ -511,14 +511,14 @@ XS(XS_utf8_is_utf8) { dXSARGS; if (items != 1) - croak_xs_usage(cv, "sv"); + croak_xs_usage(cv, "sv"); else { - SV * const sv = ST(0); - SvGETMAGIC(sv); - if (SvUTF8(sv)) - XSRETURN_YES; - else - XSRETURN_NO; + SV * const sv = ST(0); + SvGETMAGIC(sv); + if (SvUTF8(sv)) + XSRETURN_YES; + else + XSRETURN_NO; } XSRETURN_EMPTY; } @@ -528,15 +528,15 @@ XS(XS_utf8_valid) { dXSARGS; if (items != 1) - croak_xs_usage(cv, "sv"); + croak_xs_usage(cv, "sv"); else { - SV * const sv = ST(0); - STRLEN len; - const char * const s = SvPV_const(sv,len); - if (!SvUTF8(sv) || is_utf8_string((const U8*)s,len)) - XSRETURN_YES; - else - XSRETURN_NO; + SV * const sv = ST(0); + STRLEN len; + const char * const s = SvPV_const(sv,len); + if (!SvUTF8(sv) || is_utf8_string((const U8*)s,len)) + XSRETURN_YES; + else + XSRETURN_NO; } XSRETURN_EMPTY; } @@ -546,7 +546,7 @@ XS(XS_utf8_encode) { dXSARGS; if (items != 1) - croak_xs_usage(cv, "sv"); + croak_xs_usage(cv, "sv"); sv_utf8_encode(ST(0)); SvSETMAGIC(ST(0)); XSRETURN_EMPTY; @@ -557,14 +557,14 @@ XS(XS_utf8_decode) { dXSARGS; if (items != 1) - croak_xs_usage(cv, "sv"); + croak_xs_usage(cv, "sv"); else { - SV * const sv = ST(0); - bool RETVAL; - SvPV_force_nolen(sv); - RETVAL = sv_utf8_decode(sv); - SvSETMAGIC(sv); - ST(0) = boolSV(RETVAL); + SV * const sv = ST(0); + bool RETVAL; + SvPV_force_nolen(sv); + RETVAL = sv_utf8_decode(sv); + SvSETMAGIC(sv); + ST(0) = boolSV(RETVAL); } XSRETURN(1); } @@ -574,14 +574,14 @@ XS(XS_utf8_upgrade) { dXSARGS; if (items != 1) - croak_xs_usage(cv, "sv"); + croak_xs_usage(cv, "sv"); else { - SV * const sv = ST(0); - STRLEN RETVAL; - dXSTARG; + SV * const sv = ST(0); + STRLEN RETVAL; + dXSTARG; - RETVAL = sv_utf8_upgrade(sv); - XSprePUSH; PUSHi((IV)RETVAL); + RETVAL = sv_utf8_upgrade(sv); + XSprePUSH; PUSHi((IV)RETVAL); } XSRETURN(1); } @@ -591,14 +591,14 @@ XS(XS_utf8_downgrade) { dXSARGS; if (items < 1 || items > 2) - croak_xs_usage(cv, "sv, failok=0"); + croak_xs_usage(cv, "sv, failok=0"); else { - SV * const sv0 = ST(0); - SV * const sv1 = ST(1); + SV * const sv0 = ST(0); + SV * const sv1 = ST(1); const bool failok = (items < 2) ? 0 : SvTRUE_NN(sv1) ? 1 : 0; const bool RETVAL = sv_utf8_downgrade(sv0, failok); - ST(0) = boolSV(RETVAL); + ST(0) = boolSV(RETVAL); } XSRETURN(1); } @@ -643,22 +643,22 @@ XS(XS_Internals_SvREADONLY) /* This is dangerous stuff. */ sv = SvRV(svz); if (items == 1) { - if (SvREADONLY(sv)) - XSRETURN_YES; - else - XSRETURN_NO; + if (SvREADONLY(sv)) + XSRETURN_YES; + else + XSRETURN_NO; } else if (items == 2) { SV *sv1 = ST(1); - if (SvTRUE_NN(sv1)) { - SvFLAGS(sv) |= SVf_READONLY; - XSRETURN_YES; - } - else { - /* I hope you really know what you are doing. */ - SvFLAGS(sv) &=~ SVf_READONLY; - XSRETURN_NO; - } + if (SvTRUE_NN(sv1)) { + SvFLAGS(sv) |= SVf_READONLY; + XSRETURN_YES; + } + else { + /* I hope you really know what you are doing. */ + SvFLAGS(sv) &=~ SVf_READONLY; + XSRETURN_NO; + } } XSRETURN_UNDEF; /* Can't happen. */ } @@ -678,13 +678,13 @@ XS(XS_constant__make_const) /* This is dangerous stuff. */ SvREADONLY_on(sv); if (SvTYPE(sv) == SVt_PVAV && AvFILLp(sv) != -1) { - /* for constant.pm; nobody else should be calling this - on arrays anyway. */ - SV **svp; - for (svp = AvARRAY(sv) + AvFILLp(sv) - ; svp >= AvARRAY(sv) - ; --svp) - if (*svp) SvPADTMP_on(*svp); + /* for constant.pm; nobody else should be calling this + on arrays anyway. */ + SV **svp; + for (svp = AvARRAY(sv) + AvFILLp(sv) + ; svp >= AvARRAY(sv) + ; --svp) + if (*svp) SvPADTMP_on(*svp); } XSRETURN(0); } @@ -719,11 +719,11 @@ XS(XS_Internals_hv_clear_placehold) dXSARGS; if (items != 1 || !SvROK(ST(0))) - croak_xs_usage(cv, "hv"); + croak_xs_usage(cv, "hv"); else { - HV * const hv = MUTABLE_HV(SvRV(ST(0))); - hv_clear_placeholders(hv); - XSRETURN(0); + HV * const hv = MUTABLE_HV(SvRV(ST(0))); + hv_clear_placeholders(hv); + XSRETURN(0); } } @@ -732,120 +732,120 @@ XS(XS_PerlIO_get_layers) { dXSARGS; if (items < 1 || items % 2 == 0) - croak_xs_usage(cv, "filehandle[,args]"); + croak_xs_usage(cv, "filehandle[,args]"); #if defined(USE_PERLIO) { - SV * sv; - GV * gv; - IO * io; - bool input = TRUE; - bool details = FALSE; - - if (items > 1) { - SV * const *svp; - for (svp = MARK + 2; svp <= SP; svp += 2) { - SV * const * const varp = svp; - SV * const * const valp = svp + 1; - STRLEN klen; - const char * const key = SvPV_const(*varp, klen); - - switch (*key) { - case 'i': + SV * sv; + GV * gv; + IO * io; + bool input = TRUE; + bool details = FALSE; + + if (items > 1) { + SV * const *svp; + for (svp = MARK + 2; svp <= SP; svp += 2) { + SV * const * const varp = svp; + SV * const * const valp = svp + 1; + STRLEN klen; + const char * const key = SvPV_const(*varp, klen); + + switch (*key) { + case 'i': if (memEQs(key, klen, "input")) { - input = SvTRUE(*valp); - break; - } - goto fail; - case 'o': + input = SvTRUE(*valp); + break; + } + goto fail; + case 'o': if (memEQs(key, klen, "output")) { - input = !SvTRUE(*valp); - break; - } - goto fail; - case 'd': + input = !SvTRUE(*valp); + break; + } + goto fail; + case 'd': if (memEQs(key, klen, "details")) { - details = SvTRUE(*valp); - break; - } - goto fail; - default: - fail: - Perl_croak(aTHX_ - "get_layers: unknown argument '%s'", - key); - } - } - - SP -= (items - 1); - } - - sv = POPs; - gv = MAYBE_DEREF_GV(sv); - - if (!gv && !SvROK(sv)) - gv = gv_fetchsv_nomg(sv, 0, SVt_PVIO); - - if (gv && (io = GvIO(gv))) { - AV* const av = PerlIO_get_layers(aTHX_ input ? - IoIFP(io) : IoOFP(io)); - SSize_t i; - const SSize_t last = av_top_index(av); - SSize_t nitem = 0; - - for (i = last; i >= 0; i -= 3) { - SV * const * const namsvp = av_fetch(av, i - 2, FALSE); - SV * const * const argsvp = av_fetch(av, i - 1, FALSE); - SV * const * const flgsvp = av_fetch(av, i, FALSE); - - const bool namok = namsvp && *namsvp && SvPOK(*namsvp); - const bool argok = argsvp && *argsvp && SvPOK(*argsvp); - const bool flgok = flgsvp && *flgsvp && SvIOK(*flgsvp); - - EXTEND(SP, 3); /* Three is the max in all branches: better check just once */ - if (details) { - /* Indents of 5? Yuck. */ - /* We know that PerlIO_get_layers creates a new SV for - the name and flags, so we can just take a reference - and "steal" it when we free the AV below. */ - PUSHs(namok - ? sv_2mortal(SvREFCNT_inc_simple_NN(*namsvp)) - : &PL_sv_undef); - PUSHs(argok - ? newSVpvn_flags(SvPVX_const(*argsvp), - SvCUR(*argsvp), - (SvUTF8(*argsvp) ? SVf_UTF8 : 0) - | SVs_TEMP) - : &PL_sv_undef); - PUSHs(flgok - ? sv_2mortal(SvREFCNT_inc_simple_NN(*flgsvp)) - : &PL_sv_undef); - nitem += 3; - } - else { - if (namok && argok) - PUSHs(sv_2mortal(Perl_newSVpvf(aTHX_ "%" SVf "(%" SVf ")", - SVfARG(*namsvp), - SVfARG(*argsvp)))); - else if (namok) - PUSHs(sv_2mortal(SvREFCNT_inc_simple_NN(*namsvp))); - else - PUSHs(&PL_sv_undef); - nitem++; - if (flgok) { - const IV flags = SvIVX(*flgsvp); - - if (flags & PERLIO_F_UTF8) { - PUSHs(newSVpvs_flags("utf8", SVs_TEMP)); - nitem++; - } - } - } - } - - SvREFCNT_dec(av); - - XSRETURN(nitem); - } + details = SvTRUE(*valp); + break; + } + goto fail; + default: + fail: + Perl_croak(aTHX_ + "get_layers: unknown argument '%s'", + key); + } + } + + SP -= (items - 1); + } + + sv = POPs; + gv = MAYBE_DEREF_GV(sv); + + if (!gv && !SvROK(sv)) + gv = gv_fetchsv_nomg(sv, 0, SVt_PVIO); + + if (gv && (io = GvIO(gv))) { + AV* const av = PerlIO_get_layers(aTHX_ input ? + IoIFP(io) : IoOFP(io)); + SSize_t i; + const SSize_t last = av_top_index(av); + SSize_t nitem = 0; + + for (i = last; i >= 0; i -= 3) { + SV * const * const namsvp = av_fetch(av, i - 2, FALSE); + SV * const * const argsvp = av_fetch(av, i - 1, FALSE); + SV * const * const flgsvp = av_fetch(av, i, FALSE); + + const bool namok = namsvp && *namsvp && SvPOK(*namsvp); + const bool argok = argsvp && *argsvp && SvPOK(*argsvp); + const bool flgok = flgsvp && *flgsvp && SvIOK(*flgsvp); + + EXTEND(SP, 3); /* Three is the max in all branches: better check just once */ + if (details) { + /* Indents of 5? Yuck. */ + /* We know that PerlIO_get_layers creates a new SV for + the name and flags, so we can just take a reference + and "steal" it when we free the AV below. */ + PUSHs(namok + ? sv_2mortal(SvREFCNT_inc_simple_NN(*namsvp)) + : &PL_sv_undef); + PUSHs(argok + ? newSVpvn_flags(SvPVX_const(*argsvp), + SvCUR(*argsvp), + (SvUTF8(*argsvp) ? SVf_UTF8 : 0) + | SVs_TEMP) + : &PL_sv_undef); + PUSHs(flgok + ? sv_2mortal(SvREFCNT_inc_simple_NN(*flgsvp)) + : &PL_sv_undef); + nitem += 3; + } + else { + if (namok && argok) + PUSHs(sv_2mortal(Perl_newSVpvf(aTHX_ "%" SVf "(%" SVf ")", + SVfARG(*namsvp), + SVfARG(*argsvp)))); + else if (namok) + PUSHs(sv_2mortal(SvREFCNT_inc_simple_NN(*namsvp))); + else + PUSHs(&PL_sv_undef); + nitem++; + if (flgok) { + const IV flags = SvIVX(*flgsvp); + + if (flags & PERLIO_F_UTF8) { + PUSHs(newSVpvs_flags("utf8", SVs_TEMP)); + nitem++; + } + } + } + } + + SvREFCNT_dec(av); + + XSRETURN(nitem); + } } #endif @@ -858,7 +858,7 @@ XS(XS_re_is_regexp) dXSARGS; if (items != 1) - croak_xs_usage(cv, "sv"); + croak_xs_usage(cv, "sv"); if (SvRXOK(ST(0))) { XSRETURN_YES; @@ -875,7 +875,7 @@ XS(XS_re_regnames_count) dXSARGS; if (items != 0) - croak_xs_usage(cv, ""); + croak_xs_usage(cv, ""); if (!rx) XSRETURN_UNDEF; @@ -896,7 +896,7 @@ XS(XS_re_regname) SV * ret; if (items < 1 || items > 2) - croak_xs_usage(cv, "name[, all ]"); + croak_xs_usage(cv, "name[, all ]"); SP -= items; PUTBACK; @@ -932,7 +932,7 @@ XS(XS_re_regnames) SV **entry; if (items > 1) - croak_xs_usage(cv, "[all]"); + croak_xs_usage(cv, "[all]"); rx = PL_curpm ? PM_GETRE(PL_curpm) : NULL; @@ -984,7 +984,7 @@ XS(XS_re_regexp_pattern) EXTEND(SP, 2); SP -= items; if (items != 1) - croak_xs_usage(cv, "sv"); + croak_xs_usage(cv, "sv"); /* Checks if a reference is a regex or not. If the parameter is @@ -1003,8 +1003,8 @@ XS(XS_re_regexp_pattern) SV *pattern; if ( gimme == G_ARRAY ) { - STRLEN left = 0; - char reflags[sizeof(INT_PAT_MODS) + MAX_CHARSET_NAME_LENGTH]; + STRLEN left = 0; + char reflags[sizeof(INT_PAT_MODS) + MAX_CHARSET_NAME_LENGTH]; const char *fptr; char ch; U16 match_flags; @@ -1015,13 +1015,13 @@ XS(XS_re_regexp_pattern) modifiers" in this scenario, and the default character set */ - if (get_regex_charset(RX_EXTFLAGS(re)) != REGEX_DEPENDS_CHARSET) { - STRLEN len; - const char* const name = get_regex_charset_name(RX_EXTFLAGS(re), - &len); - Copy(name, reflags + left, len, char); - left += len; - } + if (get_regex_charset(RX_EXTFLAGS(re)) != REGEX_DEPENDS_CHARSET) { + STRLEN len; + const char* const name = get_regex_charset_name(RX_EXTFLAGS(re), + &len); + Copy(name, reflags + left, len, char); + left += len; + } fptr = INT_PAT_MODS; match_flags = (U16)((RX_EXTFLAGS(re) & RXf_PMf_COMPILETIME) >> RXf_PMf_STD_PMMOD_SHIFT); @@ -1034,7 +1034,7 @@ XS(XS_re_regexp_pattern) } pattern = newSVpvn_flags(RX_PRECOMP(re),RX_PRELEN(re), - (RX_UTF8(re) ? SVf_UTF8 : 0) | SVs_TEMP); + (RX_UTF8(re) ? SVf_UTF8 : 0) | SVs_TEMP); /* return the pattern and the modifiers */ PUSHs(pattern); @@ -1121,18 +1121,18 @@ XS(XS_NamedCapture_TIEHASH) if (items < 1) croak_xs_usage(cv, "package, ..."); { - const char * package = (const char *)SvPV_nolen(ST(0)); - UV flag = RXapif_ONE; - mark += 2; - while(mark < sp) { - STRLEN len; - const char *p = SvPV_const(*mark, len); - if(memEQs(p, len, "all")) - flag = SvTRUE(mark[1]) ? RXapif_ALL : RXapif_ONE; - mark += 2; - } - ST(0) = sv_2mortal(newSV_type(SVt_IV)); - sv_setuv(newSVrv(ST(0), package), flag); + const char * package = (const char *)SvPV_nolen(ST(0)); + UV flag = RXapif_ONE; + mark += 2; + while(mark < sp) { + STRLEN len; + const char *p = SvPV_const(*mark, len); + if(memEQs(p, len, "all")) + flag = SvTRUE(mark[1]) ? RXapif_ALL : RXapif_ONE; + mark += 2; + } + ST(0) = sv_2mortal(newSV_type(SVt_IV)); + sv_setuv(newSVrv(ST(0), package), flag); } XSRETURN(1); } @@ -1158,39 +1158,39 @@ XS(XS_NamedCapture_FETCH) PERL_UNUSED_VAR(ax); /* -Wall */ SP -= items; { - REGEXP *const rx = PL_curpm ? PM_GETRE(PL_curpm) : NULL; - U32 flags; - SV *ret; - const U32 action = ix & ACTION_MASK; - const int expect = ix >> EXPECT_SHIFT; - if (items != expect) - croak_xs_usage(cv, expect == 2 ? "$key" - : (expect == 3 ? "$key, $value" - : "")); - - if (!rx || !SvROK(ST(0))) { - if (ix & UNDEF_FATAL) - Perl_croak_no_modify(); - else - XSRETURN_UNDEF; - } - - flags = (U32)SvUV(SvRV(MUTABLE_SV(ST(0)))); - - PUTBACK; - ret = RX_ENGINE(rx)->named_buff(aTHX_ (rx), expect >= 2 ? ST(1) : NULL, - expect >= 3 ? ST(2) : NULL, flags | action); - SPAGAIN; - - if (ix & DISCARD) { - /* Called with G_DISCARD, so our return stack state is thrown away. - Hence if we were returned anything, free it immediately. */ - SvREFCNT_dec(ret); - } else { - PUSHs(ret ? sv_2mortal(ret) : &PL_sv_undef); - } - PUTBACK; - return; + REGEXP *const rx = PL_curpm ? PM_GETRE(PL_curpm) : NULL; + U32 flags; + SV *ret; + const U32 action = ix & ACTION_MASK; + const int expect = ix >> EXPECT_SHIFT; + if (items != expect) + croak_xs_usage(cv, expect == 2 ? "$key" + : (expect == 3 ? "$key, $value" + : "")); + + if (!rx || !SvROK(ST(0))) { + if (ix & UNDEF_FATAL) + Perl_croak_no_modify(); + else + XSRETURN_UNDEF; + } + + flags = (U32)SvUV(SvRV(MUTABLE_SV(ST(0)))); + + PUTBACK; + ret = RX_ENGINE(rx)->named_buff(aTHX_ (rx), expect >= 2 ? ST(1) : NULL, + expect >= 3 ? ST(2) : NULL, flags | action); + SPAGAIN; + + if (ix & DISCARD) { + /* Called with G_DISCARD, so our return stack state is thrown away. + Hence if we were returned anything, free it immediately. */ + SvREFCNT_dec(ret); + } else { + PUSHs(ret ? sv_2mortal(ret) : &PL_sv_undef); + } + PUTBACK; + return; } } @@ -1203,28 +1203,28 @@ XS(XS_NamedCapture_FIRSTKEY) PERL_UNUSED_VAR(ax); /* -Wall */ SP -= items; { - REGEXP *const rx = PL_curpm ? PM_GETRE(PL_curpm) : NULL; - U32 flags; - SV *ret; - const int expect = ix ? 2 : 1; - const U32 action = ix ? RXapif_NEXTKEY : RXapif_FIRSTKEY; - if (items != expect) - croak_xs_usage(cv, expect == 2 ? "$lastkey" : ""); - - if (!rx || !SvROK(ST(0))) - XSRETURN_UNDEF; - - flags = (U32)SvUV(SvRV(MUTABLE_SV(ST(0)))); - - PUTBACK; - ret = RX_ENGINE(rx)->named_buff_iter(aTHX_ (rx), - expect >= 2 ? ST(1) : NULL, - flags | action); - SPAGAIN; - - PUSHs(ret ? sv_2mortal(ret) : &PL_sv_undef); - PUTBACK; - return; + REGEXP *const rx = PL_curpm ? PM_GETRE(PL_curpm) : NULL; + U32 flags; + SV *ret; + const int expect = ix ? 2 : 1; + const U32 action = ix ? RXapif_NEXTKEY : RXapif_FIRSTKEY; + if (items != expect) + croak_xs_usage(cv, expect == 2 ? "$lastkey" : ""); + + if (!rx || !SvROK(ST(0))) + XSRETURN_UNDEF; + + flags = (U32)SvUV(SvRV(MUTABLE_SV(ST(0)))); + + PUTBACK; + ret = RX_ENGINE(rx)->named_buff_iter(aTHX_ (rx), + expect >= 2 ? ST(1) : NULL, + flags | action); + SPAGAIN; + + PUSHs(ret ? sv_2mortal(ret) : &PL_sv_undef); + PUTBACK; + return; } } @@ -1236,11 +1236,11 @@ XS(XS_NamedCapture_flags) PERL_UNUSED_VAR(ax); /* -Wall */ SP -= items; { - EXTEND(SP, 2); - mPUSHu(RXapif_ONE); - mPUSHu(RXapif_ALL); - PUTBACK; - return; + EXTEND(SP, 2); + mPUSHu(RXapif_ONE); + mPUSHu(RXapif_ALL); + PUTBACK; + return; } } @@ -1374,13 +1374,13 @@ Perl_boot_core_UNIVERSAL(pTHX) /* Providing a Regexp::DESTROY fixes #21347. See test in t/op/ref.t */ { - CV * const cv = - newCONSTSUB(get_hv("Regexp::", GV_ADD), "DESTROY", NULL); - char ** cvfile = &CvFILE(cv); - char * oldfile = *cvfile; - CvDYNFILE_off(cv); - *cvfile = (char *)file; - Safefree(oldfile); + CV * const cv = + newCONSTSUB(get_hv("Regexp::", GV_ADD), "DESTROY", NULL); + char ** cvfile = &CvFILE(cv); + char * oldfile = *cvfile; + CvDYNFILE_off(cv); + *cvfile = (char *)file; + Safefree(oldfile); } } |