diff options
| author | Father Chrysostomos <sprout@cpan.org> | 2014-11-28 14:50:33 -0800 |
|---|---|---|
| committer | Father Chrysostomos <sprout@cpan.org> | 2014-11-28 16:08:46 -0800 |
| commit | 3f25e47a026d1519ffa58a162f4679ecf489e721 (patch) | |
| tree | e8346fc3f898a210a77a922e8c77c7fb7dc7623f /ext | |
| parent | 9c54db6961be00bc06b99be899a8072d4fecb0e2 (diff) | |
| download | perl-3f25e47a026d1519ffa58a162f4679ecf489e721.tar.gz | |
Fix newFOROP with PERL_OP_PARENT and no slab
It wasn’t updating the parent pointer after reallocating the op.
Diffstat (limited to 'ext')
| -rw-r--r-- | ext/XS-APItest/APItest.xs | 17 |
1 files changed, 14 insertions, 3 deletions
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 |