@@ -1,3 +1,15 @@
+1.42 -- 2015/04/32 01:25:55
+ [CHANGES]
+ * Added List::Util::unpairs() - the inverse of pairs()
+ * Documentation to pre-warn users about the possible behaviour in a
+ later version where the pair* higher-order functionals are no longer
+ transparent to $_
+
+ [BUGFIXES]
+ * Silence some warnings at test time
+ * Ensure that the List::Util we're loading the XS via is a sufficient
+ version when Scalar::Util or Sub::Util load it (RT100863)
+
1.41 -- 2014/09/05 15:49:50
[BUGFIXES]
* Avoid pre-C99 declaration after statements (RT98624)
@@ -483,6 +483,123 @@ PPCODE:
}
void
+pairs(...)
+PROTOTYPE: @
+PPCODE:
+{
+ int argi = 0;
+ int reti = 0;
+ HV *pairstash = get_hv("List::Util::_Pair::", GV_ADD);
+
+ if(items % 2 && ckWARN(WARN_MISC))
+ warn("Odd number of elements in pairs");
+
+ {
+ 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));
+ sv_bless(ST(reti), pairstash);
+ reti++;
+ }
+ }
+
+ XSRETURN(reti);
+}
+
+void
+unpairs(...)
+PROTOTYPE: @
+PPCODE:
+{
+ /* Unlike pairs(), we're going to trash the input values on the stack
+ * almost as soon as we start generating output. So clone them first
+ */
+ int i;
+ SV **args_copy;
+ Newx(args_copy, items, SV *);
+ SAVEFREEPV(args_copy);
+
+ Copy(&ST(0), args_copy, items, SV *);
+
+ for(i = 0; i < items; i++) {
+ SV *pair = args_copy[i];
+ SvGETMAGIC(pair);
+
+ if(SvTYPE(pair) != SVt_RV)
+ croak("Not a reference at List::Util::unpack() argument %d", i);
+ if(SvTYPE(SvRV(pair)) != SVt_PVAV)
+ croak("Not an ARRAY reference at List::Util::unpack() argument %d", i);
+
+ // TODO: assert pair is an ARRAY ref
+ AV *pairav = (AV *)SvRV(pair);
+
+ EXTEND(SP, 2);
+
+ if(AvFILL(pairav) >= 0)
+ mPUSHs(newSVsv(AvARRAY(pairav)[0]));
+ else
+ PUSHs(&PL_sv_undef);
+
+ if(AvFILL(pairav) >= 1)
+ mPUSHs(newSVsv(AvARRAY(pairav)[1]));
+ else
+ PUSHs(&PL_sv_undef);
+ }
+
+ XSRETURN(items * 2);
+}
+
+void
+pairkeys(...)
+PROTOTYPE: @
+PPCODE:
+{
+ int argi = 0;
+ int reti = 0;
+
+ if(items % 2 && ckWARN(WARN_MISC))
+ warn("Odd number of elements in pairkeys");
+
+ {
+ 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;
+
+ if(items % 2 && ckWARN(WARN_MISC))
+ warn("Odd number of elements in pairvalues");
+
+ {
+ 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
pairfirst(block,...)
SV *block
PROTOTYPE: &@
@@ -768,80 +885,6 @@ PPCODE:
}
void
-pairs(...)
-PROTOTYPE: @
-PPCODE:
-{
- int argi = 0;
- int reti = 0;
- HV *pairstash = get_hv("List::Util::_Pair::", GV_ADD);
-
- if(items % 2 && ckWARN(WARN_MISC))
- warn("Odd number of elements in pairs");
-
- {
- 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));
- sv_bless(ST(reti), pairstash);
- reti++;
- }
- }
-
- XSRETURN(reti);
-}
-
-void
-pairkeys(...)
-PROTOTYPE: @
-PPCODE:
-{
- int argi = 0;
- int reti = 0;
-
- if(items % 2 && ckWARN(WARN_MISC))
- warn("Odd number of elements in pairkeys");
-
- {
- 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;
-
- if(items % 2 && ckWARN(WARN_MISC))
- warn("Odd number of elements in pairvalues");
-
- {
- 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:
@@ -4,7 +4,7 @@
"Graham Barr <gbarr@cpan.org>"
],
"dynamic_config" : 1,
- "generated_by" : "ExtUtils::MakeMaker version 6.98, CPAN::Meta::Converter version 2.142060",
+ "generated_by" : "ExtUtils::MakeMaker version 6.98, CPAN::Meta::Converter version 2.142690",
"license" : [
"perl_5"
],
@@ -42,5 +42,5 @@
"url" : "https://github.com/Scalar-List-Utils/Scalar-List-Utils"
}
},
- "version" : "1.41"
+ "version" : "1.42"
}
@@ -7,7 +7,7 @@ build_requires:
configure_requires:
ExtUtils::MakeMaker: '0'
dynamic_config: 1
-generated_by: 'ExtUtils::MakeMaker version 6.98, CPAN::Meta::Converter version 2.142060'
+generated_by: 'ExtUtils::MakeMaker version 6.98, CPAN::Meta::Converter version 2.142690'
license: perl
meta-spec:
url: http://module-build.sourceforge.net/META-spec-v1.4.html
@@ -21,4 +21,4 @@ requires:
Test::More: '0'
resources:
repository: https://github.com/Scalar-List-Utils/Scalar-List-Utils
-version: '1.41'
+version: '1.42'
@@ -4,7 +4,7 @@
"Graham Barr <gbarr@cpan.org>"
],
"dynamic_config" : 0,
- "generated_by" : "ExtUtils::MakeMaker version 6.98, CPAN::Meta::Converter version 2.142060",
+ "generated_by" : "ExtUtils::MakeMaker version 6.98, CPAN::Meta::Converter version 2.142690",
"license" : [
"perl_5"
],
@@ -42,5 +42,5 @@
"url" : "https://github.com/Scalar-List-Utils/Scalar-List-Utils"
}
},
- "version" : "1.41"
+ "version" : "1.42"
}
@@ -7,7 +7,7 @@ build_requires:
configure_requires:
ExtUtils::MakeMaker: '0'
dynamic_config: 0
-generated_by: 'ExtUtils::MakeMaker version 6.98, CPAN::Meta::Converter version 2.142060'
+generated_by: 'ExtUtils::MakeMaker version 6.98, CPAN::Meta::Converter version 2.142690'
license: perl
meta-spec:
url: http://module-build.sourceforge.net/META-spec-v1.4.html
@@ -21,4 +21,4 @@ requires:
Test::More: '0'
resources:
repository: https://github.com/Scalar-List-Utils/Scalar-List-Utils
-version: '1.41'
+version: '1.42'
@@ -2,7 +2,7 @@ package List::Util::XS;
use strict;
use List::Util;
-our $VERSION = "1.41"; # FIXUP
+our $VERSION = "1.42"; # FIXUP
$VERSION = eval $VERSION; # FIXUP
1;
@@ -12,9 +12,9 @@ require Exporter;
our @ISA = qw(Exporter);
our @EXPORT_OK = qw(
all any first min max minstr maxstr none notall product reduce sum sum0 shuffle
- pairmap pairgrep pairfirst pairs pairkeys pairvalues
+ pairs unpairs pairkeys pairvalues pairmap pairgrep pairfirst
);
-our $VERSION = "1.41";
+our $VERSION = "1.42";
our $XS_VERSION = $VERSION;
$VERSION = eval $VERSION;
@@ -254,8 +254,119 @@ or just a list of values. The functions will all preserve the original ordering
of the pairs, and will not be confused by multiple pairs having the same "key"
value - nor even do they require that the first of each pair be a plain string.
+B<NOTE>: At the time of writing, the following C<pair*> functions that take a
+block do not modify the value of C<$_> within the block, and instead operate
+using the C<$a> and C<$b> globals instead. This has turned out to be a poor
+design, as it precludes the ability to provide a C<pairsort> function. Better
+would be to pass pair-like objects as 2-element array references in C<$_>, in
+a style similar to the return value of the C<pairs> function. At some future
+version this behaviour may be added.
+
+Until then, users are alerted B<NOT> to rely on the value of C<$_> remaining
+unmodified between the outside and the inside of the control block. In
+particular, the following example is B<UNSAFE>:
+
+ my @kvlist = ...
+
+ foreach (qw( some keys here )) {
+ my @items = pairgrep { $a eq $_ } @kvlist;
+ ...
+ }
+
+Instead, write this using a lexical variable:
+
+ foreach my $key (qw( some keys here )) {
+ my @items = pairgrep { $a eq $key } @kvlist;
+ ...
+ }
+
=cut
+=head2 pairs
+
+ my @pairs = pairs @kvlist;
+
+I<Since version 1.29.>
+
+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
+
+ @pairs = pairmap { [ $a, $b ] } @kvlist
+
+It is most convenient to use in a C<foreach> loop, for example:
+
+ foreach my $pair ( pairs @KVLIST ) {
+ my ( $key, $value ) = @$pair;
+ ...
+ }
+
+Since version C<1.39> these ARRAY references are blessed objects, recognising
+the two methods C<key> and C<value>. The following code is equivalent:
+
+ foreach my $pair ( pairs @KVLIST ) {
+ my $key = $pair->key;
+ my $value = $pair->value;
+ ...
+ }
+
+=head2 unpairs
+
+ my @kvlist = unpairs @pairs
+
+I<Since version 1.42.>
+
+The inverse function to C<pairs>; this function takes a list of ARRAY
+references containing two elements each, and returns a flattened list of the
+two values from each of the pairs, in order. This is notionally equivalent to
+
+ my @kvlist = map { @{$_}[0,1] } @pairs
+
+except that it is implemented more efficiently internally. Specifically, for
+any input item it will extract exactly two values for the output list; using
+C<undef> if the input array references are short.
+
+Between C<pairs> and C<unpairs>, a higher-order list function can be used to
+operate on the pairs as single scalars; such as the following near-equivalents
+of the other C<pair*> higher-order functions:
+
+ @kvlist = unpairs grep { FUNC } pairs @kvlist
+ # Like pairgrep, but takes $_ instead of $a and $b
+
+ @kvlist = unpairs map { FUNC } pairs @kvlist
+ # Like pairmap, but takes $_ instead of $a and $b
+
+Note however that these versions will not behave as nicely in scalar context.
+
+Finally, this technique can be used to implement a sort on a keyvalue pair
+list; e.g.:
+
+ @kvlist = unpairs sort { $a->key cmp $b->key } pairs @kvlist
+
+=head2 pairkeys
+
+ my @keys = pairkeys @kvlist;
+
+I<Since version 1.29.>
+
+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
+
+ @keys = pairmap { $a } @kvlist
+
+=head2 pairvalues
+
+ my @values = pairvalues @kvlist;
+
+I<Since version 1.29.>
+
+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
+
+ @values = pairmap { $b } @kvlist
+
=head2 pairgrep
my @kvlist = pairgrep { BLOCK } @kvlist;
@@ -329,58 +440,6 @@ will be visible to the caller.
See L</KNOWN BUGS> for a known-bug with C<pairmap>, and a workaround.
-=head2 pairs
-
- my @pairs = pairs @kvlist;
-
-I<Since version 1.29.>
-
-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
-
- @pairs = pairmap { [ $a, $b ] } @kvlist
-
-It is most convenient to use in a C<foreach> loop, for example:
-
- foreach my $pair ( pairs @KVLIST ) {
- my ( $key, $value ) = @$pair;
- ...
- }
-
-Since version C<1.39> these ARRAY references are blessed objects, recognising
-the two methods C<key> and C<value>. The following code is equivalent:
-
- foreach my $pair ( pairs @KVLIST ) {
- my $key = $pair->key;
- my $value = $pair->value;
- ...
- }
-
-=head2 pairkeys
-
- my @keys = pairkeys @kvlist;
-
-I<Since version 1.29.>
-
-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
-
- @keys = pairmap { $a } @kvlist
-
-=head2 pairvalues
-
- my @values = pairvalues @kvlist;
-
-I<Since version 1.29.>
-
-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
-
- @values = pairmap { $b } @kvlist
-
=cut
=head1 OTHER FUNCTIONS
@@ -8,7 +8,6 @@ package Scalar::Util;
use strict;
require Exporter;
-require List::Util; # List::Util loads the XS
our @ISA = qw(Exporter);
our @EXPORT_OK = qw(
@@ -17,9 +16,12 @@ our @EXPORT_OK = qw(
dualvar isdual isvstring looks_like_number openhandle readonly set_prototype
tainted
);
-our $VERSION = "1.41";
+our $VERSION = "1.42";
$VERSION = eval $VERSION;
+require List::Util; # List::Util loads the XS
+List::Util->VERSION( $VERSION ); # Ensure we got the right XS version (RT#100863)
+
our @EXPORT_FAIL;
unless (defined &weaken) {
@@ -8,7 +8,6 @@ use strict;
use warnings;
require Exporter;
-require List::Util; # as it has the XS
our @ISA = qw( Exporter );
our @EXPORT_OK = qw(
@@ -16,9 +15,12 @@ our @EXPORT_OK = qw(
subname set_subname
);
-our $VERSION = "1.41";
+our $VERSION = "1.42";
$VERSION = eval $VERSION;
+require List::Util; # as it has the XS
+List::Util->VERSION( $VERSION ); # Ensure we got the right XS version (RT#100863)
+
=head1 NAME
Sub::Util - A selection of utility subroutines for subs and CODE references
@@ -3,8 +3,8 @@
use strict;
use warnings;
-use Test::More tests => 23;
-use List::Util qw(pairgrep pairfirst pairmap pairs pairkeys pairvalues);
+use Test::More tests => 26;
+use List::Util qw(pairgrep pairfirst pairmap pairs unpairs pairkeys pairvalues);
no warnings 'misc'; # avoid "Odd number of elements" warnings most of the time
@@ -96,6 +96,18 @@ is_deeply( [ pairs one => 1, two => ],
is( $p[0]->value, 1, 'pairs ->value' );
}
+is_deeply( [ unpairs [ four => 4 ], [ five => 5 ], [ six => 6 ] ],
+ [ four => 4, five => 5, six => 6 ],
+ 'unpairs' );
+
+is_deeply( [ unpairs [ four => 4 ], [ five => ] ],
+ [ four => 4, five => undef ],
+ 'unpairs with short item fills in undef' );
+
+is_deeply( [ unpairs [ four => 4 ], [ five => 5, 5 ] ],
+ [ four => 4, five => 5 ],
+ 'unpairs with long item truncates' );
+
is_deeply( [ pairkeys one => 1, two => 2 ],
[qw( one two )],
'pairkeys' );
@@ -21,7 +21,7 @@ my $t;
foreach my $r ({}, \$t, [], \*F, sub {}) {
my $n = "$r";
$n =~ /0x(\w+)/;
- my $addr = do { local $^W; hex $1 };
+ my $addr = do { no warnings; hex $1 };
my $before = ref($r);
is( refaddr($r), $addr, $n);
is( ref($r), $before, $n);