diff options
author | David Mitchell <davem@iabyn.com> | 2017-06-24 09:16:02 +0100 |
---|---|---|
committer | David Mitchell <davem@iabyn.com> | 2017-06-24 09:16:02 +0100 |
commit | 060e131ef7ef9bfe80a0751328042b9d1ae24139 (patch) | |
tree | 6e8cfe7c2888c583b1ea86fdc73cd5895131f109 | |
parent | 0599cd66b4e9bae6409714e39aa0eebc67712ca7 (diff) | |
download | perl-060e131ef7ef9bfe80a0751328042b9d1ae24139.tar.gz |
upgrade Scalar-List-Utils from 1.47 to 1.48
[CHANGES]
* Note in documentation that outer function's @_ can be accessed in
some blocks, but ought not be (thanks wchristian)
[BUGFIXES]
* Ensure pairmap extends its stack correctly (thanks davem)
* Fix name of List::Util::unpairs in its error messages
-rwxr-xr-x | Porting/Maintainers.pl | 2 | ||||
-rw-r--r-- | cpan/Scalar-List-Utils/ListUtil.xs | 66 | ||||
-rw-r--r-- | cpan/Scalar-List-Utils/lib/List/Util.pm | 11 | ||||
-rw-r--r-- | cpan/Scalar-List-Utils/lib/List/Util/XS.pm | 2 | ||||
-rw-r--r-- | cpan/Scalar-List-Utils/lib/Scalar/Util.pm | 2 | ||||
-rw-r--r-- | cpan/Scalar-List-Utils/lib/Sub/Util.pm | 2 | ||||
-rw-r--r-- | cpan/Scalar-List-Utils/t/pair.t | 12 |
7 files changed, 70 insertions, 27 deletions
diff --git a/Porting/Maintainers.pl b/Porting/Maintainers.pl index 1fe22ba8fd..340f1e37e0 100755 --- a/Porting/Maintainers.pl +++ b/Porting/Maintainers.pl @@ -959,7 +959,7 @@ use File::Glob qw(:case); }, 'Scalar-List-Utils' => { - 'DISTRIBUTION' => 'PEVANS/Scalar-List-Utils-1.47.tar.gz', + 'DISTRIBUTION' => 'PEVANS/Scalar-List-Utils-1.48.tar.gz', 'FILES' => q[cpan/Scalar-List-Utils], }, diff --git a/cpan/Scalar-List-Utils/ListUtil.xs b/cpan/Scalar-List-Utils/ListUtil.xs index 9db38045f9..2369919f85 100644 --- a/cpan/Scalar-List-Utils/ListUtil.xs +++ b/cpan/Scalar-List-Utils/ListUtil.xs @@ -636,9 +636,9 @@ PPCODE: SvGETMAGIC(pair); if(SvTYPE(pair) != SVt_RV) - croak("Not a reference at List::Util::unpack() argument %d", i); + croak("Not a reference at List::Util::unpairs() argument %d", i); if(SvTYPE(SvRV(pair)) != SVt_PVAV) - croak("Not an ARRAY reference at List::Util::unpack() argument %d", i); + croak("Not an ARRAY reference at List::Util::unpairs() argument %d", i); /* TODO: assert pair is an ARRAY ref */ pairav = (AV *)SvRV(pair); @@ -905,6 +905,7 @@ PPCODE: SV **stack = PL_stack_base + ax; I32 ret_gimme = GIMME_V; int i; + AV *spill = NULL; /* accumulates results if too big for stack */ dMULTICALL; I32 gimme = G_ARRAY; @@ -914,41 +915,64 @@ PPCODE: for(; argi < items; argi += 2) { int count; - GvSV(agv) = args_copy ? args_copy[argi] : stack[argi]; - GvSV(bgv) = argi < items-1 ? - (args_copy ? args_copy[argi+1] : stack[argi+1]) : - &PL_sv_undef; + GvSV(agv) = stack[argi]; + GvSV(bgv) = argi < items-1 ? stack[argi+1]: &PL_sv_undef; MULTICALL; count = PL_stack_sp - PL_stack_base; - if(count > 2 && !args_copy) { + if (count > 2 || spill) { /* We can't return more than 2 results for a given input pair - * without trashing the remaining argmuents on the stack still - * to be processed. So, we'll copy them out to a temporary - * buffer and work from there instead. + * without trashing the remaining arguments on the stack still + * to be processed, or possibly overrunning the stack end. + * So, we'll accumulate the results in a temporary buffer + * instead. * We didn't do this initially because in the common case, most * code blocks will return only 1 or 2 items so it won't be * necessary */ - int n_args = items - argi; - Newx(args_copy, n_args, SV *); - SAVEFREEPV(args_copy); - - Copy(stack + argi, args_copy, n_args, SV *); + int fill; + + if (!spill) { + spill = newAV(); + AvREAL_off(spill); /* don't ref count its contents */ + /* can't mortalize here as every nextstate in the code + * block frees temps */ + SAVEFREESV(spill); + } - argi = 0; - items = n_args; + fill = (int)AvFILL(spill); + av_extend(spill, fill + count); + for(i = 0; i < count; i++) + (void)av_store(spill, ++fill, + newSVsv(PL_stack_base[i + 1])); } - - for(i = 0; i < count; i++) - stack[reti++] = newSVsv(PL_stack_sp[i - count + 1]); + else + for(i = 0; i < count; i++) + stack[reti++] = newSVsv(PL_stack_base[i + 1]); } + + if (spill) + /* the POP_MULTICALL will trigger the SAVEFREESV above; + * keep it alive it on the temps stack instead */ + SvREFCNT_inc_simple_void_NN(spill); + sv_2mortal((SV*)spill); + POP_MULTICALL; + if (spill) { + int n = (int)AvFILL(spill) + 1; + SP = &ST(reti - 1); + EXTEND(SP, n); + for (i = 0; i < n; i++) + *++SP = *av_fetch(spill, i, FALSE); + reti += n; + av_clear(spill); + } + if(ret_gimme == G_ARRAY) for(i = 0; i < reti; i++) - sv_2mortal(stack[i]); + sv_2mortal(ST(i)); } else #endif diff --git a/cpan/Scalar-List-Utils/lib/List/Util.pm b/cpan/Scalar-List-Utils/lib/List/Util.pm index 47324ca065..4a03af815a 100644 --- a/cpan/Scalar-List-Utils/lib/List/Util.pm +++ b/cpan/Scalar-List-Utils/lib/List/Util.pm @@ -15,7 +15,7 @@ our @EXPORT_OK = qw( all any first min max minstr maxstr none notall product reduce sum sum0 shuffle uniq uniqnum uniqstr pairs unpairs pairkeys pairvalues pairmap pairgrep pairfirst ); -our $VERSION = "1.47"; +our $VERSION = "1.48"; our $XS_VERSION = $VERSION; $VERSION = eval $VERSION; @@ -149,6 +149,9 @@ instead, as it can short-circuit after the first true result. # at least one string has more than 10 characters } +Note: Due to XS issues the block passed may be able to access the outer @_ +directly. This is not intentional and will break under debugger. + =head2 all my $bool = all { BLOCK } @list; @@ -160,6 +163,9 @@ make the C<BLOCK> return true. If any element returns false, then it returns false. If the C<BLOCK> never returns false or the C<@list> was empty then it returns true. +Note: Due to XS issues the block passed may be able to access the outer @_ +directly. This is not intentional and will break under debugger. + =head2 none =head2 notall @@ -174,6 +180,9 @@ Similar to L</any> and L</all>, but with the return sense inverted. C<none> returns true only if no value in the C<@list> causes the C<BLOCK> to return true, and C<notall> returns true only if not all of the values do. +Note: Due to XS issues the block passed may be able to access the outer @_ +directly. This is not intentional and will break under debugger. + =head2 first my $val = first { BLOCK } @list; diff --git a/cpan/Scalar-List-Utils/lib/List/Util/XS.pm b/cpan/Scalar-List-Utils/lib/List/Util/XS.pm index a9e191fc00..c870411578 100644 --- a/cpan/Scalar-List-Utils/lib/List/Util/XS.pm +++ b/cpan/Scalar-List-Utils/lib/List/Util/XS.pm @@ -3,7 +3,7 @@ use strict; use warnings; use List::Util; -our $VERSION = "1.47"; # FIXUP +our $VERSION = "1.48"; # FIXUP $VERSION = eval $VERSION; # FIXUP 1; diff --git a/cpan/Scalar-List-Utils/lib/Scalar/Util.pm b/cpan/Scalar-List-Utils/lib/Scalar/Util.pm index bd2b9ff802..ad36af3b60 100644 --- a/cpan/Scalar-List-Utils/lib/Scalar/Util.pm +++ b/cpan/Scalar-List-Utils/lib/Scalar/Util.pm @@ -17,7 +17,7 @@ our @EXPORT_OK = qw( dualvar isdual isvstring looks_like_number openhandle readonly set_prototype tainted ); -our $VERSION = "1.47"; +our $VERSION = "1.48"; $VERSION = eval $VERSION; require List::Util; # List::Util loads the XS diff --git a/cpan/Scalar-List-Utils/lib/Sub/Util.pm b/cpan/Scalar-List-Utils/lib/Sub/Util.pm index 48f775fadb..b4ec6ac75c 100644 --- a/cpan/Scalar-List-Utils/lib/Sub/Util.pm +++ b/cpan/Scalar-List-Utils/lib/Sub/Util.pm @@ -15,7 +15,7 @@ our @EXPORT_OK = qw( subname set_subname ); -our $VERSION = "1.47"; +our $VERSION = "1.48"; $VERSION = eval $VERSION; require List::Util; # as it has the XS diff --git a/cpan/Scalar-List-Utils/t/pair.t b/cpan/Scalar-List-Utils/t/pair.t index 81acf06594..e65123cc2c 100644 --- a/cpan/Scalar-List-Utils/t/pair.t +++ b/cpan/Scalar-List-Utils/t/pair.t @@ -3,7 +3,7 @@ use strict; use warnings; -use Test::More tests => 26; +use Test::More tests => 27; use List::Util qw(pairgrep pairfirst pairmap pairs unpairs pairkeys pairvalues); no warnings 'misc'; # avoid "Odd number of elements" warnings most of the time @@ -82,6 +82,16 @@ is_deeply( [ pairmap { my @l = (1) x 1000; "$a=$b" } one => 1, two => 2, three = [ "one=1", "two=2", "three=3" ], 'pairmap copes with stack movement' ); +{ + # do the pairmap and is_deeply as two separate statements to avoid + # the stack being extended before pairmap is called + my @a = pairmap { $a .. $b } + 1 => 3, 4 => 4, 5 => 6, 7 => 1998, 1999 => 2000; + my @exp; push @exp, $_ for 1..2000; + is_deeply( \@a, \@exp, + 'pairmap result has more elements than input' ); +} + is_deeply( [ pairs one => 1, two => 2, three => 3 ], [ [ one => 1 ], [ two => 2 ], [ three => 3 ] ], 'pairs' ); |