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
