[perl.git] branch blead, updated. v5.13.5-532-gf837477

Jerry D. Hedden

2010-10-21 12:35:30 UTC

This produces a warning during 'make test':

ext/XS-APItest/t/multicall.....................................Useless
use of private variable in void context at t/multicall.t line 37.
ok

Is the '$closure_var;' statement on that line needed? Or should a 'no
warnings "void'" be added?

Post by Dave Mitchell
In perl.git, the branch blead has been updated
<http://perl5.git.perl.org/perl.git/commitdiff/f837477cd1460eda104bacd7f162d25d5254563d?hp=557af69b54d1d713b9c1c375b3485b6ee43970ec>
- Log -----------------------------------------------------------------
commit f837477cd1460eda104bacd7f162d25d5254563d
Date: Tue Oct 19 23:13:07 2010 +0100
Recursive MULTICALL prematurely freed CV
See [perl #78070].
Basically, POPSUB/LEAVESUB had a mechanism to decrement the reference
count of the CV only at CvDEPTH==1; POP_MULTICALL was decrementing it at
all depths.
M cop.h
M ext/XS-APItest/t/multicall.t
commit 9c540340879062c71c21eaf596d6df60630d5bb2
Date: Tue Oct 19 22:37:37 2010 +0100
add skeleton testing for the MULTICALL macros
The macros dMULTICALL, PUSH_MULTICALL, MULTICALL and POP_MULTICALL
are completely untested in core apart from incidentally in List-Util.
The exercise they get there is probably quite comprehensive, but it's
not explicitly testing the macros themselves.
Add a hook and new test file to XS::APItest specifically for this purpose.
Currently the test file is almost empty.
The multicall_each function is shamelessly stolen from List:;Util::first.
M MANIFEST
M ext/XS-APItest/APItest.xs
A ext/XS-APItest/t/multicall.t
-----------------------------------------------------------------------
MANIFEST | 1 +
cop.h | 4 +-
ext/XS-APItest/APItest.xs | 39 +++++++++++++++++++++++++++++++++
ext/XS-APItest/t/multicall.t | 49 ++++++++++++++++++++++++++++++++++++++++++
4 files changed, 91 insertions(+), 2 deletions(-)
create mode 100644 ext/XS-APItest/t/multicall.t
diff --git a/MANIFEST b/MANIFEST
index 0aa5c0f..7f88eb3 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -3398,6 +3398,7 @@ ext/XS-APItest/t/keyword_plugin.t test keyword plugin mechanism
ext/XS-APItest/t/looprest.t test recursive descent statement-sequence parsing
ext/XS-APItest/t/magic_chain.t test low-level MAGIC chain handling
ext/XS-APItest/t/Markers.pm Helper for ./blockhooks.t
+ext/XS-APItest/t/multicall.t XS::APItest: test MULTICALL macros
ext/XS-APItest/t/my_cxt.t XS::APItest: test MY_CXT interface
ext/XS-APItest/t/my_exit.t XS::APItest: test my_exit
ext/XS-APItest/t/Null.pm Helper for ./blockhooks.t
diff --git a/cop.h b/cop.h
index 4791c80..8e77ae2 100644
--- a/cop.h
+++ b/cop.h
@@ -928,8 +928,8 @@ See L<perlcall/Lightweight Callbacks>.
#define POP_MULTICALL \
STMT_START { \
- LEAVESUB(multicall_cv); \
- CvDEPTH(multicall_cv)--; \
+ if (! --CvDEPTH(multicall_cv)) \
+ LEAVESUB(multicall_cv); \
POPBLOCK(cx,PL_curpm); \
POPSTACK; \
CATCH_SET(multicall_oldcatch); \
diff --git a/ext/XS-APItest/APItest.xs b/ext/XS-APItest/APItest.xs
index e39281f..da37281 100644
--- a/ext/XS-APItest/APItest.xs
+++ b/ext/XS-APItest/APItest.xs
@@ -2082,6 +2082,45 @@ rpeep_record ()
RETVAL
+=pod
+
+multicall_each: call a sub for each item in the list. Used to test MULTICALL
+
+=cut
+
+void
+multicall_each(block,...)
+ SV * block
+{
+ dMULTICALL;
+ int index;
+ GV *gv;
+ HV *stash;
+ I32 gimme = G_SCALAR;
+ SV **args = &PL_stack_base[ax];
+ CV *cv;
+
+ if(items <= 1) {
+ XSRETURN_UNDEF;
+ }
+ cv = sv_2cv(block, &stash, &gv, 0);
+ if (cv == Nullcv) {
+ croak("multicall_each: not a subroutine reference");
+ }
+ PUSH_MULTICALL(cv);
+ SAVESPTR(GvSV(PL_defgv));
+
+ for(index = 1 ; index < items ; index++) {
+ GvSV(PL_defgv) = args[index];
+ MULTICALL;
+ }
+ POP_MULTICALL;
+ XSRETURN_UNDEF;
+}
+
+
{
HV* stash;
diff --git a/ext/XS-APItest/t/multicall.t b/ext/XS-APItest/t/multicall.t
new file mode 100644
index 0000000..69f7b77
--- /dev/null
+++ b/ext/XS-APItest/t/multicall.t
@@ -0,0 +1,49 @@
+#!perl -w
+
+# test the MULTICALL macros
+# Note: as of Oct 2010, there are not yet comprehensive tests
+# for these macros.
+
+use warnings;
+use strict;
+
+use Test::More tests => 6;
+use XS::APItest;
+
+
+{
+ my $sum = 0;
+ sub add { $sum += $_++ }
+
+ is($sum, 6, "sum okay");
+ is($a[0], 2, "a[0] okay");
+ is($a[1], 3, "a[1] okay");
+ is($a[2], 4, "a[2] okay");
+}
+
+# [perl #78070]
+# multicall using a sub that aleady has CvDEPTH > 1 caused sub
+# to be prematurely freed
+
+{
+ my $destroyed = 0;
+ sub REC::DESTROY { $destroyed = 1 }
+
+ my $closure_var;
+ {
+ my $f = sub {
+ $closure_var;
+ my $sub = shift;
+ if (defined $sub) {
+ XS::APItest::multicall_each \&$sub, 1,2,3;
+ }
+ };
+ bless $f, 'REC';
+ $f->($f);
+ is($destroyed, 0, "f not yet destroyed");
+ }
+ is($destroyed, 1, "f now destroyed");
+
+}
--
Perl5 Master Repository