In perl.git, the branch blead has been updated <http://perl5.git.perl.org/perl.git/commitdiff/04849b3873006f61d694fc6a67052904d3e48eee?hp=b9645564d5ebc1cf394966d175426685771ef1c6>
- Log ----------------------------------------------------------------- commit 04849b3873006f61d694fc6a67052904d3e48eee Author: David Mitchell <[email protected]> Date: Thu Jun 15 11:24:02 2017 +0100 XS::APItest::test_hv_free_ent: extend stack ... when pushing results. Ditto for XS::APItest::Hash::test_hv_delayfree_ent M ext/XS-APItest/APItest.pm M ext/XS-APItest/APItest.xs commit 78e69e607cdc9eed625a2bb8a98fbeadf0365bad Author: David Mitchell <[email protected]> Date: Thu Jun 15 11:43:42 2017 +0100 recv: reset stack when returning undef When recv() detects an error, it returns undef: but it was failing to pop its args off the stack first. So in list context it returned both its original args and undef. It was also then not extending the stack to push the undef. After this commit it resets SP to the base of its args list first, like the other ops already do which share the Perl_pp_systread() function body. M pp_sys.c commit b7effc98210707765c69fb0a0b9b695d5e7483ce Author: David Mitchell <[email protected]> Date: Tue Jun 13 13:40:50 2017 +0100 pp_leavewrite: extend stack for return value When pushing &PL_sv_yes/no on the stack, make room for it. Normally this isn't an issue as previous formlines() will have caused the stack to be extended anyway; but for the null format: format FOO = . this isn't the case. M pp_sys.c commit 2372d0731e0bd05afe2a8f9f634ef4414110b40b Author: David Mitchell <[email protected]> Date: Tue Jun 13 11:19:31 2017 +0100 argless reset(): extend stack Make space to return &PL_sv_yes if an arg wasn't popped earlier. M pp_ctl.c commit 7da51ead2909b200bcf98a4ecc6c6c6e6a209943 Author: David Mitchell <[email protected]> Date: Tue Jun 13 11:11:50 2017 +0100 extend stack on scalar empty list slice In scalar context, an empty list slice returns PL_sv_undef. Extned the stack for this return value, since if there were no elements or indices, nothing was popped from the stack M pp.c commit d5d91c1e89a7882099b788fe66dfd438c0eb0a9e Author: David Mitchell <[email protected]> Date: Tue Jun 13 11:02:42 2017 +0100 scalar reverse(): extend stack if no arg If we';re using the implicit $_ there's nothing to pop off the stack, so there may not be a spare stack slot to push the result. M pp.c commit 9399c607b775fbbf6de09b984afa5522eafc2489 Author: David Mitchell <[email protected]> Date: Tue Jun 13 09:36:13 2017 +0100 pp_match/subst: extend stack For: scalar($lex =~ /foo/) and scalar($lex =~ s/foo/$1/) there are no args on the stack, but we push PL_sv_yes/no without extending the stack first. M pp_hot.c ----------------------------------------------------------------------- Summary of changes: ext/XS-APItest/APItest.pm | 2 +- ext/XS-APItest/APItest.xs | 2 +- pp.c | 8 ++++++-- pp_ctl.c | 4 +++- pp_hot.c | 16 ++++++++++------ pp_sys.c | 6 ++++-- 6 files changed, 25 insertions(+), 13 deletions(-) diff --git a/ext/XS-APItest/APItest.pm b/ext/XS-APItest/APItest.pm index a5dd1332f6..7de08ad13e 100644 --- a/ext/XS-APItest/APItest.pm +++ b/ext/XS-APItest/APItest.pm @@ -5,7 +5,7 @@ use strict; use warnings; use Carp; -our $VERSION = '0.89'; +our $VERSION = '0.90'; require XSLoader; diff --git a/ext/XS-APItest/APItest.xs b/ext/XS-APItest/APItest.xs index e3e1593dbf..23e698c337 100644 --- a/ext/XS-APItest/APItest.xs +++ b/ext/XS-APItest/APItest.xs @@ -197,7 +197,7 @@ test_freeent(freeent_function *f) { i = 0; do { - mPUSHu(results[i]); + mXPUSHu(results[i]); } while (++i < (int)(sizeof(results)/sizeof(results[0]))); /* Goodbye to our extra reference. */ diff --git a/pp.c b/pp.c index e4072ea8b9..768eb7d82a 100644 --- a/pp.c +++ b/pp.c @@ -5209,6 +5209,7 @@ PP(pp_lslice) if (GIMME_V != G_ARRAY) { if (lastlelem < firstlelem) { + EXTEND(SP, 1); *firstlelem = &PL_sv_undef; } else { @@ -5682,8 +5683,11 @@ PP(pp_reverse) SvUTF8_off(TARG); /* decontaminate */ if (SP - MARK > 1) do_join(TARG, &PL_sv_no, MARK, SP); - else { - sv_setsv(TARG, SP > MARK ? *SP : DEFSV); + else if (SP > MARK) + sv_setsv(TARG, *SP); + else { + sv_setsv(TARG, DEFSV); + EXTEND(SP, 1); } up = SvPV_force(TARG, len); diff --git a/pp_ctl.c b/pp_ctl.c index d465a9edce..db5eabea53 100644 --- a/pp_ctl.c +++ b/pp_ctl.c @@ -2036,8 +2036,10 @@ PP(pp_reset) dSP; const char * tmps; STRLEN len = 0; - if (MAXARG < 1 || (!TOPs && !POPs)) + if (MAXARG < 1 || (!TOPs && !POPs)) { + EXTEND(SP, 1); tmps = NULL, len = 0; + } else tmps = SvPVx_const(POPs, len); sv_resetpvn(tmps, len, CopSTASH(PL_curcop)); diff --git a/pp_hot.c b/pp_hot.c index 7c98c90337..0ff3d5b48b 100644 --- a/pp_hot.c +++ b/pp_hot.c @@ -1954,10 +1954,12 @@ PP(pp_match) if (PL_op->op_flags & OPf_STACKED) TARG = POPs; - else if (ARGTARG) - GETTARGET; else { - TARG = DEFSV; + if (ARGTARG) + GETTARGET; + else { + TARG = DEFSV; + } EXTEND(SP,1); } @@ -3142,10 +3144,12 @@ PP(pp_subst) if (PL_op->op_flags & OPf_STACKED) TARG = POPs; - else if (ARGTARG) - GETTARGET; else { - TARG = DEFSV; + if (ARGTARG) + GETTARGET; + else { + TARG = DEFSV; + } EXTEND(SP,1); } diff --git a/pp_sys.c b/pp_sys.c index 74c89008fa..65900faf5a 100644 --- a/pp_sys.c +++ b/pp_sys.c @@ -1554,6 +1554,8 @@ PP(pp_leavewrite) retop = cx->blk_sub.retop; CX_POP(cx); + EXTEND(SP, 1); + if (is_return) /* XXX the semantics of doing 'return' in a format aren't documented. * Currently we ignore any args to 'return' and just return @@ -1758,7 +1760,7 @@ PP(pp_sysread) char namebuf[MAXPATHLEN]; if (fd < 0) { SETERRNO(EBADF,SS_IVCHAN); - RETPUSHUNDEF; + goto say_undef; } #if (defined(VMS_DO_SOCKETS) && defined(DECCRTL_SOCKETS)) || defined(__QNXNTO__) bufsize = sizeof (struct sockaddr_in); @@ -1774,7 +1776,7 @@ PP(pp_sysread) count = PerlSock_recvfrom(fd, buffer, length, offset, (struct sockaddr *)namebuf, &bufsize); if (count < 0) - RETPUSHUNDEF; + goto say_undef; /* MSG_TRUNC can give oversized count; quietly lose it */ if (count > length) count = length; -- Perl5 Master Repository
