op.c:newFOROP: Fall back to realloc for unslabbed ops

When an op is allocated, PL_compcv is checked to see whether it can
hold an op slab if it does not hold one already.  If PL_compcv is not
usable, for whatever reason, it falls back to malloc.

Since the new slab allocator was added in commit 8be227a, newFOROP has
been assuming, probably correctly, that its listop which it needs to
enlarge to a loopop was allocated by slab.

Since newFOROP is an API function, we should err on the safe side and
check first whether the op is slab-allocated, falling back to realloc
if it is not.

To trigger this potential bug, one has to set things up such that
there is a usable pad available, but no usable PL_compcv.  I said
‘probably correctly’ above because this situation is highly unlikely
and probably indicative of bugs elsewhere.  (But we should still err
on the side of safety.)

diff --git a/ext/XS-APItest/APItest.xs b/ext/XS-APItest/APItest.xs
index 8138ad5..57c8fd0 100644 (file)
--- a/ext/XS-APItest/APItest.xs
+++ b/ext/XS-APItest/APItest.xs
@@ -3360,6 +3360,25 @@ OUTPUT:
 
 #endif
 
+bool
+test_newFOROP_without_slab()
+CODE:
+    {
+       const I32 floor = start_subparse(0,0);
+       CV * const cv = PL_compcv;
+       /* 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));
+       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
+
+
 MODULE = XS::APItest PACKAGE = XS::APItest::AUTOLOADtest
 
 int

diff --git a/ext/XS-APItest/t/op.t b/ext/XS-APItest/t/op.t
index 8a92a24..258f573 100644 (file)
--- a/ext/XS-APItest/t/op.t
+++ b/ext/XS-APItest/t/op.t
@@ -10,3 +10,6 @@ use_ok('XS::APItest');
 *hint_fetch = *hint_fetch = \&XS::APItest::Hash::refcounted_he_fetch;
 
 require '../../t/op/caller.pl';
+
+ok test_newFOROP_without_slab(),
+     'no assertion failures when allocating FOROP without slab';

diff --git a/op.c b/op.c
index ecda97e..acc0e92 100644 (file)
--- a/op.c
+++ b/op.c
@@ -6445,7 +6445,8 @@ Perl_newFOROP(pTHX_ I32 flags, OP *sv, OP *expr, OP *block, OP *cont)
      * for our $x () sets OPpOUR_INTRO */
     loop->op_private = (U8)iterpflags;
 #ifndef PL_OP_SLAB_ALLOC
-    if (DIFF(loop, OpSLOT(loop)->opslot_next)
+    if (loop->op_slabbed
+     && DIFF(loop, OpSLOT(loop)->opslot_next)
         < SIZE_TO_PSIZE(sizeof(LOOP)))
 #endif
     {
@@ -6455,6 +6456,10 @@ Perl_newFOROP(pTHX_ I32 flags, OP *sv, OP *expr, OP *block, OP *cont)
        S_op_destroy(aTHX_ (OP*)loop);
        loop = tmp;
     }
+#ifndef PL_OP_SLAB_ALLOC
+    else if (!loop->op_slabbed)
+       loop = (LOOP*)PerlMemShared_realloc(loop, sizeof(LOOP));
+#endif
     loop->op_targ = padoff;
     wop = newWHILEOP(flags, 1, loop, newOP(OP_ITER, 0), block, cont, 0);
     if (madsv)