Chris 'Bingos' Williams
2013-08-01 21:01:45 UTC
In perl.git, the branch blead has been updated
<http://perl5.git.perl.org/perl.git/commitdiff/2dc8d72598874681e38466a0d335798ca3c7b416?hp=685bfc3ccf3109c4c537bd9aad1ba87ccce84bde>
- Log -----------------------------------------------------------------
commit 2dc8d72598874681e38466a0d335798ca3c7b416
Author: Chris 'BinGOs' Williams <***@bingosnet.co.uk>
Date: Thu Aug 1 21:07:00 2013 +0100
Update Scalar-List-Utils to CPAN version 1.29
[DELTA]
1.29 -- Thu Aug 01 13:40 UTC 2013
* Bugfix to pairmap/pairgrep when stack moves beneath them during operation
1.28 -- Thu Aug 01 12:19 UTC 2013
-- BROKEN; do not use. See 1.29
* Added pairgrep, pairmap, pairs (inspired by List::Pairwise)
* Added pairkeys and pairvalues
-----------------------------------------------------------------------
Summary of changes:
MANIFEST | 1 +
Porting/Maintainers.pl | 2 +-
cpan/List-Util/Changes | 10 +++
cpan/List-Util/ListUtil.xs | 175 +++++++++++++++++++++++++++++++++++++
cpan/List-Util/lib/List/Util.pm | 70 ++++++++++++++-
cpan/List-Util/lib/List/Util/XS.pm | 2 +-
cpan/List-Util/lib/Scalar/Util.pm | 2 +-
cpan/List-Util/t/blessed.t | 13 +--
cpan/List-Util/t/pair.t | 63 +++++++++++++
pod/perldelta.pod | 7 ++
10 files changed, 334 insertions(+), 11 deletions(-)
create mode 100644 cpan/List-Util/t/pair.t
diff --git a/MANIFEST b/MANIFEST
index 245d425..1b6f056 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -1422,6 +1422,7 @@ cpan/List-Util/t/minstr.t List::Util
cpan/List-Util/t/min.t List::Util
cpan/List-Util/t/multicall-refcount.t
cpan/List-Util/t/openhan.t Scalar::Util
+cpan/List-Util/t/pair.t
cpan/List-Util/t/proto.t Scalar::Util
cpan/List-Util/t/readonly.t Scalar::Util
cpan/List-Util/t/reduce.t List::Util
diff --git a/Porting/Maintainers.pl b/Porting/Maintainers.pl
index e93604c..c8021a7 100755
--- a/Porting/Maintainers.pl
+++ b/Porting/Maintainers.pl
@@ -1537,7 +1537,7 @@ use File::Glob qw(:case);
'Scalar-List-Utils' => {
'MAINTAINER' => 'gbarr',
- 'DISTRIBUTION' => 'PEVANS/Scalar-List-Utils-1.27.tar.gz',
+ 'DISTRIBUTION' => 'PEVANS/Scalar-List-Utils-1.29.tar.gz',
# Note that perl uses its own version of Makefile.PL
'FILES' => q[cpan/List-Util],
diff --git a/cpan/List-Util/Changes b/cpan/List-Util/Changes
index 9ab9804..032b4ef 100644
--- a/cpan/List-Util/Changes
+++ b/cpan/List-Util/Changes
@@ -1,3 +1,13 @@
+1.29 -- Thu Aug 01 13:40 UTC 2013
+
+ * Bugfix to pairmap/pairgrep when stack moves beneath them during operation
+
+1.28 -- Thu Aug 01 12:19 UTC 2013
+ -- BROKEN; do not use. See 1.29
+
+ * Added pairgrep, pairmap, pairs (inspired by List::Pairwise)
+ * Added pairkeys and pairvalues
+
1.26_001 -- Sun Dec 23 15:58
* Fix multicall refcount bug RT#80646
diff --git a/cpan/List-Util/ListUtil.xs b/cpan/List-Util/ListUtil.xs
index 1ae74cd..d2f2f11 100644
--- a/cpan/List-Util/ListUtil.xs
+++ b/cpan/List-Util/ListUtil.xs
@@ -339,9 +339,184 @@ CODE:
XSRETURN_UNDEF;
}
+void
+pairgrep(block,...)
+ SV * block
+PROTOTYPE: &@
+PPCODE:
+{
+ GV *agv,*bgv,*gv;
+ HV *stash;
+ CV *cv = sv_2cv(block, &stash, &gv, 0);
+
+ /* This function never returns more than it consumed in arguments. So we
+ * can build the results "live", behind the arguments
+ */
+ int argi = 1; // "shift" the block
+ int reti = 0;
+
+ agv = gv_fetchpv("a", GV_ADD, SVt_PV);
+ bgv = gv_fetchpv("b", GV_ADD, SVt_PV);
+ SAVESPTR(GvSV(agv));
+ SAVESPTR(GvSV(bgv));
+
+ {
+ for(; argi < items; argi += 2) {
+ dSP;
+ SV *a = GvSV(agv) = ST(argi);
+ SV *b = GvSV(bgv) = argi < items-1 ? ST(argi+1) : &PL_sv_undef;
+
+ PUSHMARK(SP);
+ call_sv((SV*)cv, G_SCALAR);
+
+ SPAGAIN;
+
+ if (SvTRUEx(*PL_stack_sp)) {
+ if(GIMME_V == G_ARRAY) {
+ ST(reti++) = sv_mortalcopy(a);
+ ST(reti++) = sv_mortalcopy(b);
+ }
+ else if(GIMME_V == G_SCALAR)
+ reti++;
+ }
+ }
+ }
+
+ if(GIMME_V == G_ARRAY)
+ XSRETURN(reti);
+ else if(GIMME_V == G_SCALAR) {
+ ST(0) = newSViv(reti);
+ XSRETURN(1);
+ }
+}
+
+void
+pairmap(block,...)
+ SV * block
+PROTOTYPE: &@
+PPCODE:
+{
+ GV *agv,*bgv,*gv;
+ HV *stash;
+ CV *cv = sv_2cv(block, &stash, &gv, 0);
+ SV **args_copy = NULL;
+
+ int argi = 1; // "shift" the block
+ int reti = 0;
+
+ agv = gv_fetchpv("a", GV_ADD, SVt_PV);
+ bgv = gv_fetchpv("b", GV_ADD, SVt_PV);
+ SAVESPTR(GvSV(agv));
+ SAVESPTR(GvSV(bgv));
+
+ {
+ for(; argi < items; argi += 2) {
+ dSP;
+ SV *a = GvSV(agv) = args_copy ? args_copy[argi] : ST(argi);
+ SV *b = GvSV(bgv) = argi < items-1 ?
+ (args_copy ? args_copy[argi+1] : ST(argi+1)) :
+ &PL_sv_undef;
+
+ PUSHMARK(SP);
+ int count = call_sv((SV*)cv, G_ARRAY);
+
+ SPAGAIN;
+
+ if(count > 2 && !args_copy) {
+ /* 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.
+ * 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(&ST(argi), args_copy, n_args, SV *);
+
+ argi = 0;
+ items = n_args;
+ }
+
+ int i;
+ for(i = 0; i < count; i++)
+ ST(reti++) = sv_mortalcopy(SP[i - count + 1]);
+
+ PUTBACK;
+ }
+ }
+
+ XSRETURN(reti);
+}
+
#endif
void
+pairs(...)
+PROTOTYPE: @
+PPCODE:
+{
+ int argi = 0;
+ int reti = 0;
+
+ {
+ for(; argi < items; argi += 2) {
+ SV *a = ST(argi);
+ SV *b = argi < items-1 ? ST(argi+1) : &PL_sv_undef;
+
+ AV *av = newAV();
+ av_push(av, newSVsv(a));
+ av_push(av, newSVsv(b));
+
+ ST(reti++) = sv_2mortal(newRV_noinc((SV *)av));
+ }
+ }
+
+ XSRETURN(reti);
+}
+
+void
+pairkeys(...)
+PROTOTYPE: @
+PPCODE:
+{
+ int argi = 0;
+ int reti = 0;
+
+ {
+ for(; argi < items; argi += 2) {
+ SV *a = ST(argi);
+
+ ST(reti++) = sv_2mortal(newSVsv(a));
+ }
+ }
+
+ XSRETURN(reti);
+}
+
+void
+pairvalues(...)
+PROTOTYPE: @
+PPCODE:
+{
+ int argi = 0;
+ int reti = 0;
+
+ {
+ for(; argi < items; argi += 2) {
+ SV *b = argi < items-1 ? ST(argi+1) : &PL_sv_undef;
+
+ ST(reti++) = sv_2mortal(newSVsv(b));
+ }
+ }
+
+ XSRETURN(reti);
+}
+
+void
shuffle(...)
PROTOTYPE: @
CODE:
diff --git a/cpan/List-Util/lib/List/Util.pm b/cpan/List-Util/lib/List/Util.pm
index 5988aa9..7801f6f 100644
--- a/cpan/List-Util/lib/List/Util.pm
+++ b/cpan/List-Util/lib/List/Util.pm
@@ -12,8 +12,8 @@ use strict;
require Exporter;
our @ISA = qw(Exporter);
-our @EXPORT_OK = qw(first min max minstr maxstr reduce sum sum0 shuffle);
-our $VERSION = "1.27";
+our @EXPORT_OK = qw(first min max minstr maxstr reduce sum sum0 shuffle pairmap pairgrep pairs pairkeys pairvalues);
+our $VERSION = "1.29";
our $XS_VERSION = $VERSION;
$VERSION = eval $VERSION;
@@ -122,6 +122,72 @@ This function could be implemented using C<reduce> like this
$foo = reduce { $a lt $b ? $a : $b } 'A'..'Z'
+=item pairgrep BLOCK KVLIST
+
+Similar to perl's C<grep> keyword, but interprets the given list as an
+even-sized list of pairs. It invokes the BLOCK multiple times, in scalar
+context, with C<$a> and C<$b> set to successive pairs of values from the
+KVLIST.
+
+Returns an even-sized list of those pairs for which the BLOCK returned true
+in list context, or the count of the B<number of pairs> in scalar context.
+(Note, therefore, in scalar context that it returns a number half the size
+of the count of items it would have returned in list context).
+
+ @subset = pairgrep { $a =~ m/^[[:upper:]]+$/ } @kvlist
+
+Similar to C<grep>, C<pairgrep> aliases C<$a> and C<$b> to elements of the
+given list. Any modifications of it by the code block will be visible to
+the caller.
+
+=item pairmap BLOCK KVLIST
+
+Similar to perl's C<map> keyword, but interprets the given list as an
+even-sized list of pairs. It invokes the BLOCK multiple times, in list
+context, with C<$a> and C<$b> set to successive pairs of values from the
+KVLIST.
+
+Returns the concatenation of all the values returned by the BLOCK in list
+context, or the count of the number of items that would have been returned
+in scalar context.
+
+ @result = pairmap { "The key $a has value $b" } @kvlist
+
+Similar to C<map>, C<pairmap> aliases C<$a> and C<$b> to elements of the
+given list. Any modifications of it by the code block will be visible to
+the caller.
+
+=item pairs KVLIST
+
+A convenient shortcut to operating on even-sized lists of pairs, this
+function returns a list of ARRAY references, each containing two items from
+the given list. It is a more efficient version of
+
+ pairmap { [ $a, $b ] } KVLIST
+
+It is most convenient to use in a C<foreach> loop, for example:
+
+ foreach ( pairs @KVLIST ) {
+ my ( $key, $value ) = @$_;
+ ...
+ }
+
+=item pairkeys KVLIST
+
+A convenient shortcut to operating on even-sized lists of pairs, this
+function returns a list of the the first values of each of the pairs in
+the given list. It is a more efficient version of
+
+ pairmap { $a } KVLIST
+
+=item pairvalues KVLIST
+
+A convenient shortcut to operating on even-sized lists of pairs, this
+function returns a list of the the second values of each of the pairs in
+the given list. It is a more efficient version of
+
+ pairmap { $b } KVLIST
+
=item reduce BLOCK LIST
Reduces LIST by calling BLOCK, in a scalar context, multiple times,
diff --git a/cpan/List-Util/lib/List/Util/XS.pm b/cpan/List-Util/lib/List/Util/XS.pm
index 01b944b..e2167f8 100644
--- a/cpan/List-Util/lib/List/Util/XS.pm
+++ b/cpan/List-Util/lib/List/Util/XS.pm
@@ -2,7 +2,7 @@ package List::Util::XS;
use strict;
use List::Util;
-our $VERSION = "1.27"; # FIXUP
+our $VERSION = "1.29"; # FIXUP
$VERSION = eval $VERSION; # FIXUP
1;
diff --git a/cpan/List-Util/lib/Scalar/Util.pm b/cpan/List-Util/lib/Scalar/Util.pm
index da22989..ddfa0ef 100644
--- a/cpan/List-Util/lib/Scalar/Util.pm
+++ b/cpan/List-Util/lib/Scalar/Util.pm
@@ -26,7 +26,7 @@ our @EXPORT_OK = qw(
tainted
weaken
);
-our $VERSION = "1.27";
+our $VERSION = "1.29";
$VERSION = eval $VERSION;
our @EXPORT_FAIL;
diff --git a/cpan/List-Util/t/blessed.t b/cpan/List-Util/t/blessed.t
index f0a4c19..1d448af 100644
--- a/cpan/List-Util/t/blessed.t
+++ b/cpan/List-Util/t/blessed.t
@@ -34,13 +34,14 @@ $x = bless {}, "0";
cmp_ok(blessed($x), "eq", "0", 'blessed HASH-ref');
{
- my $depth;
- {
+ my $blessed = do {
+ my $depth;
no warnings 'redefine';
- *UNIVERSAL::can = sub { die "Burp!" if ++$depth > 2; blessed(shift) };
- }
- $x = bless {}, "DEF";
- is(blessed($x), "DEF", 'recursion of UNIVERSAL::can');
+ local *UNIVERSAL::can = sub { die "Burp!" if ++$depth > 2; blessed(shift) };
+ $x = bless {}, "DEF";
+ blessed($x);
+ };
+ is($blessed, "DEF", 'recursion of UNIVERSAL::can');
}
{
diff --git a/cpan/List-Util/t/pair.t b/cpan/List-Util/t/pair.t
new file mode 100644
index 0000000..f4c4289
--- /dev/null
+++ b/cpan/List-Util/t/pair.t
@@ -0,0 +1,63 @@
+#!./perl
+
+use strict;
+use Test::More tests => 13;
+use List::Util qw(pairgrep pairmap pairs pairkeys pairvalues);
+
+is_deeply( [ pairgrep { $b % 2 } one => 1, two => 2, three => 3 ],
+ [ one => 1, three => 3 ],
+ 'pairgrep list' );
+
+is( scalar( pairgrep { $b & 2 } one => 1, two => 2, three => 3 ),
+ 2,
+ 'pairgrep scalar' );
+
+is_deeply( [ pairgrep { $a } 0 => "zero", 1 => "one", 2 ],
+ [ 1 => "one", 2 => undef ],
+ 'pairgrep pads with undef' );
+
+{
+ my @kvlist = ( one => 1, two => 2 );
+ pairgrep { $b++ } @kvlist;
+ is_deeply( \@kvlist, [ one => 2, two => 3 ], 'pairgrep aliases elements' );
+}
+
+is_deeply( [ pairmap { uc $a => $b } one => 1, two => 2, three => 3 ],
+ [ ONE => 1, TWO => 2, THREE => 3 ],
+ 'pairmap list' );
+
+is_deeply( [ pairmap { $a => @$b } one => [1,1,1], two => [2,2,2], three => [3,3,3] ],
+ [ one => 1, 1, 1, two => 2, 2, 2, three => 3, 3, 3 ],
+ 'pairmap list returning >2 items' );
+
+is_deeply( [ pairmap { $b } one => 1, two => 2, three => ],
+ [ 1, 2, undef ],
+ 'pairmap pads with undef' );
+
+{
+ my @kvlist = ( one => 1, two => 2 );
+ pairmap { $b++ } @kvlist;
+ is_deeply( \@kvlist, [ one => 2, two => 3 ], 'pairmap aliases elements' );
+}
+
+# Calculating a 1000-element list should hopefully cause the stack to move
+# underneath pairmap
+is_deeply( [ pairmap { my @l = (1) x 1000; "$a=$b" } one => 1, two => 2, three => 3 ],
+ [ "one=1", "two=2", "three=3" ],
+ 'pairmap copes with stack movement' );
+
+is_deeply( [ pairs one => 1, two => 2, three => 3 ],
+ [ [ one => 1 ], [ two => 2 ], [ three => 3 ] ],
+ 'pairs' );
+
+is_deeply( [ pairs one => 1, two => ],
+ [ [ one => 1 ], [ two => undef ] ],
+ 'pairs pads with undef' );
+
+is_deeply( [ pairkeys one => 1, two => 2 ],
+ [qw( one two )],
+ 'pairkeys' );
+
+is_deeply( [ pairvalues one => 1, two => 2 ],
+ [ 1, 2 ],
+ 'pairvalues' );
diff --git a/pod/perldelta.pod b/pod/perldelta.pod
index 515afda1..940f183 100644
--- a/pod/perldelta.pod
+++ b/pod/perldelta.pod
@@ -162,6 +162,13 @@ C<Exporter::Heavy>. [perl #39739]
=item *
+L<List::Util> has been upgraded from version 1.27 to 1.29
+
+L<List::Util> now includes C<pairgrep>, C<pairmap>, C<pairs>, C<pairkeys>
+and C<pairvalues> functions that operate on even-sized lists of pairs.
+
+=item *
+
L<parent> has been upgraded from version 0.225 to 0.226.
=item *
--
Perl5 Master Repository
<http://perl5.git.perl.org/perl.git/commitdiff/2dc8d72598874681e38466a0d335798ca3c7b416?hp=685bfc3ccf3109c4c537bd9aad1ba87ccce84bde>
- Log -----------------------------------------------------------------
commit 2dc8d72598874681e38466a0d335798ca3c7b416
Author: Chris 'BinGOs' Williams <***@bingosnet.co.uk>
Date: Thu Aug 1 21:07:00 2013 +0100
Update Scalar-List-Utils to CPAN version 1.29
[DELTA]
1.29 -- Thu Aug 01 13:40 UTC 2013
* Bugfix to pairmap/pairgrep when stack moves beneath them during operation
1.28 -- Thu Aug 01 12:19 UTC 2013
-- BROKEN; do not use. See 1.29
* Added pairgrep, pairmap, pairs (inspired by List::Pairwise)
* Added pairkeys and pairvalues
-----------------------------------------------------------------------
Summary of changes:
MANIFEST | 1 +
Porting/Maintainers.pl | 2 +-
cpan/List-Util/Changes | 10 +++
cpan/List-Util/ListUtil.xs | 175 +++++++++++++++++++++++++++++++++++++
cpan/List-Util/lib/List/Util.pm | 70 ++++++++++++++-
cpan/List-Util/lib/List/Util/XS.pm | 2 +-
cpan/List-Util/lib/Scalar/Util.pm | 2 +-
cpan/List-Util/t/blessed.t | 13 +--
cpan/List-Util/t/pair.t | 63 +++++++++++++
pod/perldelta.pod | 7 ++
10 files changed, 334 insertions(+), 11 deletions(-)
create mode 100644 cpan/List-Util/t/pair.t
diff --git a/MANIFEST b/MANIFEST
index 245d425..1b6f056 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -1422,6 +1422,7 @@ cpan/List-Util/t/minstr.t List::Util
cpan/List-Util/t/min.t List::Util
cpan/List-Util/t/multicall-refcount.t
cpan/List-Util/t/openhan.t Scalar::Util
+cpan/List-Util/t/pair.t
cpan/List-Util/t/proto.t Scalar::Util
cpan/List-Util/t/readonly.t Scalar::Util
cpan/List-Util/t/reduce.t List::Util
diff --git a/Porting/Maintainers.pl b/Porting/Maintainers.pl
index e93604c..c8021a7 100755
--- a/Porting/Maintainers.pl
+++ b/Porting/Maintainers.pl
@@ -1537,7 +1537,7 @@ use File::Glob qw(:case);
'Scalar-List-Utils' => {
'MAINTAINER' => 'gbarr',
- 'DISTRIBUTION' => 'PEVANS/Scalar-List-Utils-1.27.tar.gz',
+ 'DISTRIBUTION' => 'PEVANS/Scalar-List-Utils-1.29.tar.gz',
# Note that perl uses its own version of Makefile.PL
'FILES' => q[cpan/List-Util],
diff --git a/cpan/List-Util/Changes b/cpan/List-Util/Changes
index 9ab9804..032b4ef 100644
--- a/cpan/List-Util/Changes
+++ b/cpan/List-Util/Changes
@@ -1,3 +1,13 @@
+1.29 -- Thu Aug 01 13:40 UTC 2013
+
+ * Bugfix to pairmap/pairgrep when stack moves beneath them during operation
+
+1.28 -- Thu Aug 01 12:19 UTC 2013
+ -- BROKEN; do not use. See 1.29
+
+ * Added pairgrep, pairmap, pairs (inspired by List::Pairwise)
+ * Added pairkeys and pairvalues
+
1.26_001 -- Sun Dec 23 15:58
* Fix multicall refcount bug RT#80646
diff --git a/cpan/List-Util/ListUtil.xs b/cpan/List-Util/ListUtil.xs
index 1ae74cd..d2f2f11 100644
--- a/cpan/List-Util/ListUtil.xs
+++ b/cpan/List-Util/ListUtil.xs
@@ -339,9 +339,184 @@ CODE:
XSRETURN_UNDEF;
}
+void
+pairgrep(block,...)
+ SV * block
+PROTOTYPE: &@
+PPCODE:
+{
+ GV *agv,*bgv,*gv;
+ HV *stash;
+ CV *cv = sv_2cv(block, &stash, &gv, 0);
+
+ /* This function never returns more than it consumed in arguments. So we
+ * can build the results "live", behind the arguments
+ */
+ int argi = 1; // "shift" the block
+ int reti = 0;
+
+ agv = gv_fetchpv("a", GV_ADD, SVt_PV);
+ bgv = gv_fetchpv("b", GV_ADD, SVt_PV);
+ SAVESPTR(GvSV(agv));
+ SAVESPTR(GvSV(bgv));
+
+ {
+ for(; argi < items; argi += 2) {
+ dSP;
+ SV *a = GvSV(agv) = ST(argi);
+ SV *b = GvSV(bgv) = argi < items-1 ? ST(argi+1) : &PL_sv_undef;
+
+ PUSHMARK(SP);
+ call_sv((SV*)cv, G_SCALAR);
+
+ SPAGAIN;
+
+ if (SvTRUEx(*PL_stack_sp)) {
+ if(GIMME_V == G_ARRAY) {
+ ST(reti++) = sv_mortalcopy(a);
+ ST(reti++) = sv_mortalcopy(b);
+ }
+ else if(GIMME_V == G_SCALAR)
+ reti++;
+ }
+ }
+ }
+
+ if(GIMME_V == G_ARRAY)
+ XSRETURN(reti);
+ else if(GIMME_V == G_SCALAR) {
+ ST(0) = newSViv(reti);
+ XSRETURN(1);
+ }
+}
+
+void
+pairmap(block,...)
+ SV * block
+PROTOTYPE: &@
+PPCODE:
+{
+ GV *agv,*bgv,*gv;
+ HV *stash;
+ CV *cv = sv_2cv(block, &stash, &gv, 0);
+ SV **args_copy = NULL;
+
+ int argi = 1; // "shift" the block
+ int reti = 0;
+
+ agv = gv_fetchpv("a", GV_ADD, SVt_PV);
+ bgv = gv_fetchpv("b", GV_ADD, SVt_PV);
+ SAVESPTR(GvSV(agv));
+ SAVESPTR(GvSV(bgv));
+
+ {
+ for(; argi < items; argi += 2) {
+ dSP;
+ SV *a = GvSV(agv) = args_copy ? args_copy[argi] : ST(argi);
+ SV *b = GvSV(bgv) = argi < items-1 ?
+ (args_copy ? args_copy[argi+1] : ST(argi+1)) :
+ &PL_sv_undef;
+
+ PUSHMARK(SP);
+ int count = call_sv((SV*)cv, G_ARRAY);
+
+ SPAGAIN;
+
+ if(count > 2 && !args_copy) {
+ /* 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.
+ * 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(&ST(argi), args_copy, n_args, SV *);
+
+ argi = 0;
+ items = n_args;
+ }
+
+ int i;
+ for(i = 0; i < count; i++)
+ ST(reti++) = sv_mortalcopy(SP[i - count + 1]);
+
+ PUTBACK;
+ }
+ }
+
+ XSRETURN(reti);
+}
+
#endif
void
+pairs(...)
+PROTOTYPE: @
+PPCODE:
+{
+ int argi = 0;
+ int reti = 0;
+
+ {
+ for(; argi < items; argi += 2) {
+ SV *a = ST(argi);
+ SV *b = argi < items-1 ? ST(argi+1) : &PL_sv_undef;
+
+ AV *av = newAV();
+ av_push(av, newSVsv(a));
+ av_push(av, newSVsv(b));
+
+ ST(reti++) = sv_2mortal(newRV_noinc((SV *)av));
+ }
+ }
+
+ XSRETURN(reti);
+}
+
+void
+pairkeys(...)
+PROTOTYPE: @
+PPCODE:
+{
+ int argi = 0;
+ int reti = 0;
+
+ {
+ for(; argi < items; argi += 2) {
+ SV *a = ST(argi);
+
+ ST(reti++) = sv_2mortal(newSVsv(a));
+ }
+ }
+
+ XSRETURN(reti);
+}
+
+void
+pairvalues(...)
+PROTOTYPE: @
+PPCODE:
+{
+ int argi = 0;
+ int reti = 0;
+
+ {
+ for(; argi < items; argi += 2) {
+ SV *b = argi < items-1 ? ST(argi+1) : &PL_sv_undef;
+
+ ST(reti++) = sv_2mortal(newSVsv(b));
+ }
+ }
+
+ XSRETURN(reti);
+}
+
+void
shuffle(...)
PROTOTYPE: @
CODE:
diff --git a/cpan/List-Util/lib/List/Util.pm b/cpan/List-Util/lib/List/Util.pm
index 5988aa9..7801f6f 100644
--- a/cpan/List-Util/lib/List/Util.pm
+++ b/cpan/List-Util/lib/List/Util.pm
@@ -12,8 +12,8 @@ use strict;
require Exporter;
our @ISA = qw(Exporter);
-our @EXPORT_OK = qw(first min max minstr maxstr reduce sum sum0 shuffle);
-our $VERSION = "1.27";
+our @EXPORT_OK = qw(first min max minstr maxstr reduce sum sum0 shuffle pairmap pairgrep pairs pairkeys pairvalues);
+our $VERSION = "1.29";
our $XS_VERSION = $VERSION;
$VERSION = eval $VERSION;
@@ -122,6 +122,72 @@ This function could be implemented using C<reduce> like this
$foo = reduce { $a lt $b ? $a : $b } 'A'..'Z'
+=item pairgrep BLOCK KVLIST
+
+Similar to perl's C<grep> keyword, but interprets the given list as an
+even-sized list of pairs. It invokes the BLOCK multiple times, in scalar
+context, with C<$a> and C<$b> set to successive pairs of values from the
+KVLIST.
+
+Returns an even-sized list of those pairs for which the BLOCK returned true
+in list context, or the count of the B<number of pairs> in scalar context.
+(Note, therefore, in scalar context that it returns a number half the size
+of the count of items it would have returned in list context).
+
+ @subset = pairgrep { $a =~ m/^[[:upper:]]+$/ } @kvlist
+
+Similar to C<grep>, C<pairgrep> aliases C<$a> and C<$b> to elements of the
+given list. Any modifications of it by the code block will be visible to
+the caller.
+
+=item pairmap BLOCK KVLIST
+
+Similar to perl's C<map> keyword, but interprets the given list as an
+even-sized list of pairs. It invokes the BLOCK multiple times, in list
+context, with C<$a> and C<$b> set to successive pairs of values from the
+KVLIST.
+
+Returns the concatenation of all the values returned by the BLOCK in list
+context, or the count of the number of items that would have been returned
+in scalar context.
+
+ @result = pairmap { "The key $a has value $b" } @kvlist
+
+Similar to C<map>, C<pairmap> aliases C<$a> and C<$b> to elements of the
+given list. Any modifications of it by the code block will be visible to
+the caller.
+
+=item pairs KVLIST
+
+A convenient shortcut to operating on even-sized lists of pairs, this
+function returns a list of ARRAY references, each containing two items from
+the given list. It is a more efficient version of
+
+ pairmap { [ $a, $b ] } KVLIST
+
+It is most convenient to use in a C<foreach> loop, for example:
+
+ foreach ( pairs @KVLIST ) {
+ my ( $key, $value ) = @$_;
+ ...
+ }
+
+=item pairkeys KVLIST
+
+A convenient shortcut to operating on even-sized lists of pairs, this
+function returns a list of the the first values of each of the pairs in
+the given list. It is a more efficient version of
+
+ pairmap { $a } KVLIST
+
+=item pairvalues KVLIST
+
+A convenient shortcut to operating on even-sized lists of pairs, this
+function returns a list of the the second values of each of the pairs in
+the given list. It is a more efficient version of
+
+ pairmap { $b } KVLIST
+
=item reduce BLOCK LIST
Reduces LIST by calling BLOCK, in a scalar context, multiple times,
diff --git a/cpan/List-Util/lib/List/Util/XS.pm b/cpan/List-Util/lib/List/Util/XS.pm
index 01b944b..e2167f8 100644
--- a/cpan/List-Util/lib/List/Util/XS.pm
+++ b/cpan/List-Util/lib/List/Util/XS.pm
@@ -2,7 +2,7 @@ package List::Util::XS;
use strict;
use List::Util;
-our $VERSION = "1.27"; # FIXUP
+our $VERSION = "1.29"; # FIXUP
$VERSION = eval $VERSION; # FIXUP
1;
diff --git a/cpan/List-Util/lib/Scalar/Util.pm b/cpan/List-Util/lib/Scalar/Util.pm
index da22989..ddfa0ef 100644
--- a/cpan/List-Util/lib/Scalar/Util.pm
+++ b/cpan/List-Util/lib/Scalar/Util.pm
@@ -26,7 +26,7 @@ our @EXPORT_OK = qw(
tainted
weaken
);
-our $VERSION = "1.27";
+our $VERSION = "1.29";
$VERSION = eval $VERSION;
our @EXPORT_FAIL;
diff --git a/cpan/List-Util/t/blessed.t b/cpan/List-Util/t/blessed.t
index f0a4c19..1d448af 100644
--- a/cpan/List-Util/t/blessed.t
+++ b/cpan/List-Util/t/blessed.t
@@ -34,13 +34,14 @@ $x = bless {}, "0";
cmp_ok(blessed($x), "eq", "0", 'blessed HASH-ref');
{
- my $depth;
- {
+ my $blessed = do {
+ my $depth;
no warnings 'redefine';
- *UNIVERSAL::can = sub { die "Burp!" if ++$depth > 2; blessed(shift) };
- }
- $x = bless {}, "DEF";
- is(blessed($x), "DEF", 'recursion of UNIVERSAL::can');
+ local *UNIVERSAL::can = sub { die "Burp!" if ++$depth > 2; blessed(shift) };
+ $x = bless {}, "DEF";
+ blessed($x);
+ };
+ is($blessed, "DEF", 'recursion of UNIVERSAL::can');
}
{
diff --git a/cpan/List-Util/t/pair.t b/cpan/List-Util/t/pair.t
new file mode 100644
index 0000000..f4c4289
--- /dev/null
+++ b/cpan/List-Util/t/pair.t
@@ -0,0 +1,63 @@
+#!./perl
+
+use strict;
+use Test::More tests => 13;
+use List::Util qw(pairgrep pairmap pairs pairkeys pairvalues);
+
+is_deeply( [ pairgrep { $b % 2 } one => 1, two => 2, three => 3 ],
+ [ one => 1, three => 3 ],
+ 'pairgrep list' );
+
+is( scalar( pairgrep { $b & 2 } one => 1, two => 2, three => 3 ),
+ 2,
+ 'pairgrep scalar' );
+
+is_deeply( [ pairgrep { $a } 0 => "zero", 1 => "one", 2 ],
+ [ 1 => "one", 2 => undef ],
+ 'pairgrep pads with undef' );
+
+{
+ my @kvlist = ( one => 1, two => 2 );
+ pairgrep { $b++ } @kvlist;
+ is_deeply( \@kvlist, [ one => 2, two => 3 ], 'pairgrep aliases elements' );
+}
+
+is_deeply( [ pairmap { uc $a => $b } one => 1, two => 2, three => 3 ],
+ [ ONE => 1, TWO => 2, THREE => 3 ],
+ 'pairmap list' );
+
+is_deeply( [ pairmap { $a => @$b } one => [1,1,1], two => [2,2,2], three => [3,3,3] ],
+ [ one => 1, 1, 1, two => 2, 2, 2, three => 3, 3, 3 ],
+ 'pairmap list returning >2 items' );
+
+is_deeply( [ pairmap { $b } one => 1, two => 2, three => ],
+ [ 1, 2, undef ],
+ 'pairmap pads with undef' );
+
+{
+ my @kvlist = ( one => 1, two => 2 );
+ pairmap { $b++ } @kvlist;
+ is_deeply( \@kvlist, [ one => 2, two => 3 ], 'pairmap aliases elements' );
+}
+
+# Calculating a 1000-element list should hopefully cause the stack to move
+# underneath pairmap
+is_deeply( [ pairmap { my @l = (1) x 1000; "$a=$b" } one => 1, two => 2, three => 3 ],
+ [ "one=1", "two=2", "three=3" ],
+ 'pairmap copes with stack movement' );
+
+is_deeply( [ pairs one => 1, two => 2, three => 3 ],
+ [ [ one => 1 ], [ two => 2 ], [ three => 3 ] ],
+ 'pairs' );
+
+is_deeply( [ pairs one => 1, two => ],
+ [ [ one => 1 ], [ two => undef ] ],
+ 'pairs pads with undef' );
+
+is_deeply( [ pairkeys one => 1, two => 2 ],
+ [qw( one two )],
+ 'pairkeys' );
+
+is_deeply( [ pairvalues one => 1, two => 2 ],
+ [ 1, 2 ],
+ 'pairvalues' );
diff --git a/pod/perldelta.pod b/pod/perldelta.pod
index 515afda1..940f183 100644
--- a/pod/perldelta.pod
+++ b/pod/perldelta.pod
@@ -162,6 +162,13 @@ C<Exporter::Heavy>. [perl #39739]
=item *
+L<List::Util> has been upgraded from version 1.27 to 1.29
+
+L<List::Util> now includes C<pairgrep>, C<pairmap>, C<pairs>, C<pairkeys>
+and C<pairvalues> functions that operate on even-sized lists of pairs.
+
+=item *
+
L<parent> has been upgraded from version 0.225 to 0.226.
=item *
--
Perl5 Master Repository