This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
make MULTICALL safe across cxstack reallocs
authorDavid Mitchell <davem@iabyn.com>
Sun, 11 Nov 2012 00:01:21 +0000 (00:01 +0000)
committerDavid Mitchell <davem@iabyn.com>
Sun, 11 Nov 2012 00:01:21 +0000 (00:01 +0000)
[perl #115602]
MUTLICALL sets a local var, cx, to point to the current context stack
frame. When a function is called, the context stack might be realloc()ed,
in which case cx would point to freed memory.

cop.h
ext/XS-APItest/t/multicall.t

diff --git a/cop.h b/cop.h
index 4c7b710..74ec151 100644 (file)
--- a/cop.h
+++ b/cop.h
@@ -1217,7 +1217,8 @@ See L<perlcall/LIGHTWEIGHT CALLBACKS>.
 
 #define POP_MULTICALL \
     STMT_START {                                                       \
-       if (! ((CvDEPTH(multicall_cv) = cx->blk_sub.olddepth)) ) {      \
+       cx = &cxstack[cxstack_ix];                                      \
+        if (! ((CvDEPTH(multicall_cv) = cx->blk_sub.olddepth)) ) {     \
                LEAVESUB(multicall_cv);                                 \
        }                                                               \
        POPBLOCK(cx,PL_curpm);                                          \
index 983f5fd..f96f62e 100644 (file)
@@ -7,7 +7,7 @@
 use warnings;
 use strict;
 
-use Test::More tests => 6;
+use Test::More tests => 7;
 use XS::APItest;
 
 
@@ -48,3 +48,16 @@ use XS::APItest;
     is($destroyed, 1, "f now destroyed");
 
 }
+
+# [perl #115602]
+# deep recursion realloced the CX stack, but the dMULTICALL local var
+# 'cx' still pointed to the old one.
+# Thius doesn;t actually test the failure (I couldn't think of a way to
+# get the failure to show at the perl level) but it allows valgribnd or
+# similar to spot any errors.
+
+{
+    sub rec { my $c = shift; rec($c-1) if $c > 0 };
+    my @r = XS::APItest::multicall_each { rec(90) } 1,2,3;
+    pass("recursion");
+}