Bug #113939 for Scalar-List-Utils: [PATCH] support lexical $_

The multicalls any,all,... first only set the global $_ not the lexical, if the code contains a pad with a lexical $_. This simple to fix bug was e.g. the cited reason to remove my $_ from p5p core. http://www.nntp.perl.org/group/perl.perl5.porters/2013/02/msg198988.html lexical-topic is still supported in cperl and earlier perls. For the dreaded 5.24 p5p core release the deprecated call to find_rundefsvoffset will just throw a compile-time deprecation warning, for subsequent releases they will maybe come to their mind. Attached is the List::Util fix for this. We can only be lucky that this module is yet maintained by p5p. -- Reini Urban

diff --git cpan/Scalar-List-Utils/ListUtil.xs cpan/Scalar-List-Utils/ListUtil.xs index b2dbc7c..d2d0c34 100644 --- cpan/Scalar-List-Utils/ListUtil.xs +++ cpan/Scalar-List-Utils/ListUtil.xs @@ -435,14 +435,11 @@ CODE: HV *stash; SV **args = &PL_stack_base[ax]; CV *cv = sv_2cv(block, &stash, &gv, 0); - + PADOFFSET targlex; if(cv == Nullcv) croak("Not a subroutine reference"); - if(items <= 1) XSRETURN_UNDEF; - - SAVESPTR(GvSV(PL_defgv)); #ifdef dMULTICALL if(!CvISXSUB(cv)) { dMULTICALL; @@ -451,11 +448,16 @@ CODE: UNUSED_VAR_newsp; PUSH_MULTICALL(cv); + targlex = find_rundefsvoffset(); + if (targlex == NOT_IN_PAD) + SAVESPTR(GvSV(PL_defgv)); for(index = 1 ; index < items ; index++) { - SV *def_sv = GvSV(PL_defgv) = args[index]; -# ifdef SvTEMP_off - SvTEMP_off(def_sv); -# endif + if (targlex != NOT_IN_PAD) { + PAD_SVl(targlex) = args[index]; + SvREFCNT_inc_NN(PAD_SVl(targlex)); + } + else + GvSV(PL_defgv) = args[index]; MULTICALL; if(SvTRUEx(*PL_stack_sp)) { # ifdef PERL_HAS_BAD_MULTICALL_REFCOUNT @@ -476,6 +478,7 @@ CODE: else #endif { + SAVESPTR(GvSV(PL_defgv)); for(index = 1 ; index < items ; index++) { dSP; GvSV(PL_defgv) = args[index]; @@ -512,21 +515,32 @@ PPCODE: if(cv == Nullcv) croak("Not a subroutine reference"); - - SAVESPTR(GvSV(PL_defgv)); #ifdef dMULTICALL if(!CvISXSUB(cv)) { dMULTICALL; I32 gimme = G_SCALAR; int index; + PADOFFSET targlex; UNUSED_VAR_newsp; PUSH_MULTICALL(cv); + + targlex = find_rundefsvoffset(); + if (targlex == NOT_IN_PAD) + SAVESPTR(GvSV(PL_defgv)); for(index = 1; index < items; index++) { - SV *def_sv = GvSV(PL_defgv) = args[index]; + if (targlex != NOT_IN_PAD) { + PAD_SVl(targlex) = args[index]; + SvREFCNT_inc_NN(PAD_SVl(targlex)); + } else { # ifdef SvTEMP_off - SvTEMP_off(def_sv); + SV *def_sv = # endif + GvSV(PL_defgv) = args[index]; +# ifdef SvTEMP_off + SvTEMP_off(def_sv); +# endif + } MULTICALL; if(SvTRUEx(*PL_stack_sp) ^ invert) { @@ -541,6 +555,7 @@ PPCODE: #endif { int index; + SAVESPTR(GvSV(PL_defgv)); for(index = 1; index < items; index++) { dSP; GvSV(PL_defgv) = args[index]; diff --git cpan/Scalar-List-Utils/t/any-all.t cpan/Scalar-List-Utils/t/any-all.t index f1626c2..e4d11d4 100644 --- cpan/Scalar-List-Utils/t/any-all.t +++ cpan/Scalar-List-Utils/t/any-all.t @@ -4,7 +4,7 @@ use strict; use warnings; use List::Util qw(any all notall none); -use Test::More tests => 12; +use Test::More tests => 13; ok( (any { $_ == 1 } 1, 2, 3), 'any true' ); ok( !(any { $_ == 1 } 2, 3, 4), 'any false' ); @@ -21,3 +21,10 @@ ok( !(notall { 1 }), 'notall empty list' ); ok( (none { $_ == 1 } 2, 3, 4), 'none true' ); ok( !(none { $_ == 1 } 1, 2, 3), 'none false' ); ok( (none { 1 }), 'none empty list' ); + +{ + no warnings 'experimental::lexical_topic'; + my $_ = "foo"; + ok( any { $_ eq "a" } qw(a b c), 'any my $_'); +} + diff --git cpan/Scalar-List-Utils/t/first.t cpan/Scalar-List-Utils/t/first.t index ba7726a..c1b789c 100644 --- cpan/Scalar-List-Utils/t/first.t +++ cpan/Scalar-List-Utils/t/first.t @@ -5,7 +5,7 @@ use warnings; use List::Util qw(first); use Test::More; -plan tests => 22 + ($::PERL_ONLY ? 0 : 2); +plan tests => 23 + ($::PERL_ONLY ? 0 : 2); my $v; ok(defined &first, 'defined'); @@ -126,3 +126,9 @@ ok($@ =~ /^Not a subroutine reference/, 'check for code reference'); eval { &first(+{},1,2,3) }; ok($@ =~ /^Not a subroutine reference/, 'check for code reference'); +{ + no warnings 'experimental::lexical_topic'; + my $_ = 1; + $v = first { $_ > 6 } 2,4,6,12; + is($v, 12, 'first with lexical my'); +}