summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorDavid Mitchell <davem@iabyn.com>2017-06-24 09:16:02 +0100
committerDavid Mitchell <davem@iabyn.com>2017-06-24 09:16:02 +0100
commit060e131ef7ef9bfe80a0751328042b9d1ae24139 (patch)
tree6e8cfe7c2888c583b1ea86fdc73cd5895131f109
parent0599cd66b4e9bae6409714e39aa0eebc67712ca7 (diff)
downloadperl-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-xPorting/Maintainers.pl2
-rw-r--r--cpan/Scalar-List-Utils/ListUtil.xs66
-rw-r--r--cpan/Scalar-List-Utils/lib/List/Util.pm11
-rw-r--r--cpan/Scalar-List-Utils/lib/List/Util/XS.pm2
-rw-r--r--cpan/Scalar-List-Utils/lib/Scalar/Util.pm2
-rw-r--r--cpan/Scalar-List-Utils/lib/Sub/Util.pm2
-rw-r--r--cpan/Scalar-List-Utils/t/pair.t12
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' );