In perl.git, the branch blead has been updated <http://perl5.git.perl.org/perl.git/commitdiff/fdae947323b49384fccc4ae1603c2e5fca04f0f1?hp=41e1f0ed87316699cf6574906797bee3dd759fb0>
- Log ----------------------------------------------------------------- commit fdae947323b49384fccc4ae1603c2e5fca04f0f1 Author: Nicholas Clark <n...@ccl4.org> Date: Wed Oct 13 16:16:11 2010 +0100 Consistent stack handling for XS_re_regnames_* This may also fix bugs for the (untested) cases where the called routine returns NULL, and the calling routine attempted XSRETURN_UNDEF. M universal.c commit cb525dbe8838a8e289f2e8f893dd8df441c740c4 Author: Nicholas Clark <n...@ccl4.org> Date: Wed Oct 13 14:37:16 2010 +0100 Consistent usage messages for XS_Tie_Hash_NamedCapture_* The $flags argument is actually the object, so should not be mentioned. M universal.c commit 0cf05ef1177b39ff322b92e7bf0e21b642395f49 Author: Nicholas Clark <n...@ccl4.org> Date: Wed Oct 13 14:12:27 2010 +0100 In XS_Tie_Hash_NamedCapture_{CLEAR,STORE}, free any returned value. The calling convention for CALLREG_NAMED_BUFF_*() is to return NULL, or a reference to a scalar. For CLEAR and STORE we return no values, so if we're erroneously passed a reference, we should free it to stop it being leaked. M universal.c commit 05099f26a2ddd438807aa96853b7e317f8afc787 Author: Nicholas Clark <n...@ccl4.org> Date: Wed Oct 13 13:56:38 2010 +0100 Consistent stack handling for XS_Tie_Hash_NamedCapture_* This may also fix bugs for the (untested) cases where CALLREG_NAMED_BUFF_* returned NULL, and the calling routine attempted XSRETURN_UNDEF. It's fine to call sv_2mortal() on the immortals returned by CALLREG_NAMED_BUFF_EXISTS() M universal.c ----------------------------------------------------------------------- Summary of changes: universal.c | 103 ++++++++++++++++++++++++++--------------------------------- 1 files changed, 45 insertions(+), 58 deletions(-) diff --git a/universal.c b/universal.c index e66e0db..52d701c 100644 --- a/universal.c +++ b/universal.c @@ -1038,8 +1038,6 @@ XS(XS_re_is_regexp) if (items != 1) croak_xs_usage(cv, "sv"); - SP -= items; - if (SvRXOK(ST(0))) { XSRETURN_YES; } else { @@ -1058,6 +1056,7 @@ XS(XS_re_regnames_count) croak_xs_usage(cv, ""); SP -= items; + PUTBACK; if (!rx) XSRETURN_UNDEF; @@ -1065,14 +1064,8 @@ XS(XS_re_regnames_count) ret = CALLREG_NAMED_BUFF_COUNT(rx); SPAGAIN; - - if (ret) { - mXPUSHs(ret); - PUTBACK; - return; - } else { - XSRETURN_UNDEF; - } + PUSHs(ret ? sv_2mortal(ret) : &PL_sv_undef); + XSRETURN(1); } XS(XS_re_regname) @@ -1087,6 +1080,7 @@ XS(XS_re_regname) croak_xs_usage(cv, "name[, all ]"); SP -= items; + PUTBACK; rx = PL_curpm ? PM_GETRE(PL_curpm) : NULL; @@ -1100,11 +1094,9 @@ XS(XS_re_regname) } ret = CALLREG_NAMED_BUFF_FETCH(rx, ST(0), (flags | RXapif_REGNAME)); - if (ret) { - mXPUSHs(ret); - XSRETURN(1); - } - XSRETURN_UNDEF; + SPAGAIN; + PUSHs(ret ? sv_2mortal(ret) : &PL_sv_undef); + XSRETURN(1); } @@ -1135,13 +1127,12 @@ XS(XS_re_regnames) } SP -= items; + PUTBACK; ret = CALLREG_NAMED_BUFF_ALL(rx, (flags | RXapif_REGNAMES)); SPAGAIN; - SP -= items; - if (!ret) XSRETURN_UNDEF; @@ -1272,7 +1263,7 @@ XS(XS_Tie_Hash_NamedCapture_FETCH) SV * ret; if (items != 2) - croak_xs_usage(cv, "$key, $flags"); + croak_xs_usage(cv, "$key"); rx = PL_curpm ? PM_GETRE(PL_curpm) : NULL; @@ -1280,18 +1271,14 @@ XS(XS_Tie_Hash_NamedCapture_FETCH) XSRETURN_UNDEF; SP -= items; + PUTBACK; flags = (U32)SvUV(SvRV(MUTABLE_SV(ST(0)))); ret = CALLREG_NAMED_BUFF_FETCH(rx, ST(1), flags); SPAGAIN; - - if (ret) { - mXPUSHs(ret); - PUTBACK; - return; - } - XSRETURN_UNDEF; + PUSHs(ret ? sv_2mortal(ret) : &PL_sv_undef); + XSRETURN(1); } XS(XS_Tie_Hash_NamedCapture_STORE) @@ -1300,9 +1287,10 @@ XS(XS_Tie_Hash_NamedCapture_STORE) dXSARGS; REGEXP * rx; U32 flags; + SV *ret; if (items != 3) - croak_xs_usage(cv, "$key, $value, $flags"); + croak_xs_usage(cv, "$key, $value"); rx = PL_curpm ? PM_GETRE(PL_curpm) : NULL; @@ -1311,12 +1299,18 @@ XS(XS_Tie_Hash_NamedCapture_STORE) } SP -= items; + PUTBACK; flags = (U32)SvUV(SvRV(MUTABLE_SV(ST(0)))); - CALLREG_NAMED_BUFF_STORE(rx,ST(1), ST(2), flags); + ret = CALLREG_NAMED_BUFF_STORE(rx,ST(1), ST(2), flags); + /* Perl_magic_setpack calls us with G_DISCARD, so our return stack state is thrown away. */ + + /* If we were returned anything, free it immediately. */ + SvREFCNT_dec(ret); + XSRETURN_EMPTY; } XS(XS_Tie_Hash_NamedCapture_DELETE) @@ -1328,16 +1322,18 @@ XS(XS_Tie_Hash_NamedCapture_DELETE) SV *ret; if (items != 2) - croak_xs_usage(cv, "$key, $flags"); + croak_xs_usage(cv, "$key"); if (!rx || !SvROK(ST(0))) Perl_croak_no_modify(aTHX); SP -= items; + PUTBACK; flags = (U32)SvUV(SvRV(MUTABLE_SV(ST(0)))); ret = CALLREG_NAMED_BUFF_DELETE(rx, ST(1), flags); + SPAGAIN; PUSHs(ret ? sv_2mortal(ret) : &PL_sv_undef); XSRETURN(1); } @@ -1348,9 +1344,10 @@ XS(XS_Tie_Hash_NamedCapture_CLEAR) dXSARGS; REGEXP * rx; U32 flags; + SV *ret; if (items != 1) - croak_xs_usage(cv, "$flags"); + croak_xs_usage(cv, ""); rx = PL_curpm ? PM_GETRE(PL_curpm) : NULL; @@ -1358,12 +1355,17 @@ XS(XS_Tie_Hash_NamedCapture_CLEAR) Perl_croak_no_modify(aTHX); SP -= items; + PUTBACK; flags = (U32)SvUV(SvRV(MUTABLE_SV(ST(0)))); - CALLREG_NAMED_BUFF_CLEAR(rx, flags); + ret = CALLREG_NAMED_BUFF_CLEAR(rx, flags); /* Perl_magic_wipepack calls us with G_DISCARD, so our return stack state is thrown away. */ + + /* If we were returned anything, free it immediately. */ + SvREFCNT_dec(ret); + XSRETURN_EMPTY; } XS(XS_Tie_Hash_NamedCapture_EXISTS) @@ -1375,7 +1377,7 @@ XS(XS_Tie_Hash_NamedCapture_EXISTS) SV * ret; if (items != 2) - croak_xs_usage(cv, "$key, $flags"); + croak_xs_usage(cv, "$key"); rx = PL_curpm ? PM_GETRE(PL_curpm) : NULL; @@ -1383,15 +1385,14 @@ XS(XS_Tie_Hash_NamedCapture_EXISTS) XSRETURN_UNDEF; SP -= items; + PUTBACK; flags = (U32)SvUV(SvRV(MUTABLE_SV(ST(0)))); ret = CALLREG_NAMED_BUFF_EXISTS(rx, ST(1), flags); SPAGAIN; - - XPUSHs(ret); - PUTBACK; - return; + PUSHs(ret ? sv_2mortal(ret) : &PL_sv_undef); + XSRETURN(1); } XS(XS_Tie_Hash_NamedCapture_FIRSTK) @@ -1411,19 +1412,14 @@ XS(XS_Tie_Hash_NamedCapture_FIRSTK) XSRETURN_UNDEF; SP -= items; + PUTBACK; flags = (U32)SvUV(SvRV(MUTABLE_SV(ST(0)))); ret = CALLREG_NAMED_BUFF_FIRSTKEY(rx, flags); SPAGAIN; - - if (ret) { - mXPUSHs(ret); - PUTBACK; - } else { - XSRETURN_UNDEF; - } - + PUSHs(ret ? sv_2mortal(ret) : &PL_sv_undef); + XSRETURN(1); } XS(XS_Tie_Hash_NamedCapture_NEXTK) @@ -1443,18 +1439,14 @@ XS(XS_Tie_Hash_NamedCapture_NEXTK) XSRETURN_UNDEF; SP -= items; + PUTBACK; flags = (U32)SvUV(SvRV(MUTABLE_SV(ST(0)))); ret = CALLREG_NAMED_BUFF_NEXTKEY(rx, ST(1), flags); SPAGAIN; - - if (ret) { - mXPUSHs(ret); - } else { - XSRETURN_UNDEF; - } - PUTBACK; + PUSHs(ret ? sv_2mortal(ret) : &PL_sv_undef); + XSRETURN(1); } XS(XS_Tie_Hash_NamedCapture_SCALAR) @@ -1474,19 +1466,14 @@ XS(XS_Tie_Hash_NamedCapture_SCALAR) XSRETURN_UNDEF; SP -= items; + PUTBACK; flags = (U32)SvUV(SvRV(MUTABLE_SV(ST(0)))); ret = CALLREG_NAMED_BUFF_SCALAR(rx, flags); SPAGAIN; - - if (ret) { - mXPUSHs(ret); - PUTBACK; - return; - } else { - XSRETURN_UNDEF; - } + PUSHs(ret ? sv_2mortal(ret) : &PL_sv_undef); + XSRETURN(1); } XS(XS_Tie_Hash_NamedCapture_flags) -- Perl5 Master Repository