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? On Tue, Oct 19, 2010 at 18:31, Dave Mitchell <[email protected]> wrote: > In perl.git, the branch blead has been updated > > <http://perl5.git.perl.org/perl.git/commitdiff/f837477cd1460eda104bacd7f162d25d5254563d?hp=557af69b54d1d713b9c1c375b3485b6ee43970ec> > > - Log ----------------------------------------------------------------- > commit f837477cd1460eda104bacd7f162d25d5254563d > Author: David Mitchell <[email protected]> > 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 > Author: David Mitchell <[email protected]> > 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 > ----------------------------------------------------------------------- > > Summary of changes: > 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 () > OUTPUT: > RETVAL > > +=pod > + > +multicall_each: call a sub for each item in the list. Used to test MULTICALL > + > +=cut > + > +void > +multicall_each(block,...) > + SV * block > +PROTOTYPE: &@ > +CODE: > +{ > + 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; > +} > + > + > BOOT: > { > 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 += $_++ } > + > + my @a = (1..3); > + XS::APItest::multicall_each \&add, @a; > + 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 >
