From 3f25e47a026d1519ffa58a162f4679ecf489e721 Mon Sep 17 00:00:00 2001 From: Father Chrysostomos Date: Fri, 28 Nov 2014 14:50:33 -0800 Subject: Fix newFOROP with PERL_OP_PARENT and no slab MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit It wasn’t updating the parent pointer after reallocating the op. --- ext/XS-APItest/APItest.xs | 17 ++++++++++++++--- 1 file changed, 14 insertions(+), 3 deletions(-) (limited to 'ext') diff --git a/ext/XS-APItest/APItest.xs b/ext/XS-APItest/APItest.xs index 8d3d23a90b..a3810b5cdd 100644 --- a/ext/XS-APItest/APItest.xs +++ b/ext/XS-APItest/APItest.xs @@ -3635,14 +3635,25 @@ test_newFOROP_without_slab() CODE: { const I32 floor = start_subparse(0,0); + OP *o; /* The slab allocator does not like CvROOT being set. */ CvROOT(PL_compcv) = (OP *)1; - op_free(newFOROP(0, 0, newOP(OP_PUSHMARK, 0), 0, 0)); + o = newFOROP(0, 0, newOP(OP_PUSHMARK, 0), 0, 0); +#ifdef PERL_OP_PARENT + if (cLOOPx(cUNOPo->op_first)->op_last->op_sibling + != cUNOPo->op_first) + { + Perl_warn(aTHX_ "Op parent pointer is stale"); + RETVAL = FALSE; + } + else +#endif + /* If we do not crash before returning, the test passes. */ + RETVAL = TRUE; + op_free(o); CvROOT(PL_compcv) = NULL; SvREFCNT_dec(PL_compcv); LEAVE_SCOPE(floor); - /* If we have not crashed yet, then the test passes. */ - RETVAL = TRUE; } OUTPUT: RETVAL -- cgit v1.2.1