diff options
-rwxr-xr-x | Porting/Maintainers.pl | 2 | ||||
-rw-r--r-- | cpan/Scalar-List-Utils/ListUtil.xs | 191 | ||||
-rw-r--r-- | cpan/Scalar-List-Utils/lib/List/Util.pm | 167 | ||||
-rw-r--r-- | cpan/Scalar-List-Utils/lib/List/Util/XS.pm | 2 | ||||
-rw-r--r-- | cpan/Scalar-List-Utils/lib/Scalar/Util.pm | 6 | ||||
-rw-r--r-- | cpan/Scalar-List-Utils/lib/Sub/Util.pm | 6 | ||||
-rw-r--r-- | cpan/Scalar-List-Utils/t/pair.t | 16 | ||||
-rw-r--r-- | cpan/Scalar-List-Utils/t/refaddr.t | 2 | ||||
-rw-r--r-- | pod/perldelta.pod | 4 |
9 files changed, 259 insertions, 137 deletions
diff --git a/Porting/Maintainers.pl b/Porting/Maintainers.pl index 09d44d395b..29379756d9 100755 --- a/Porting/Maintainers.pl +++ b/Porting/Maintainers.pl @@ -980,7 +980,7 @@ use File::Glob qw(:case); }, 'Scalar-List-Utils' => { - 'DISTRIBUTION' => 'PEVANS/Scalar-List-Utils-1.41.tar.gz', + 'DISTRIBUTION' => 'PEVANS/Scalar-List-Utils-1.42.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 515677f162..a7cd20caab 100644 --- a/cpan/Scalar-List-Utils/ListUtil.xs +++ b/cpan/Scalar-List-Utils/ListUtil.xs @@ -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: diff --git a/cpan/Scalar-List-Utils/lib/List/Util.pm b/cpan/Scalar-List-Utils/lib/List/Util.pm index 837b6c89a2..735aebb666 100644 --- a/cpan/Scalar-List-Utils/lib/List/Util.pm +++ b/cpan/Scalar-List-Utils/lib/List/Util.pm @@ -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 diff --git a/cpan/Scalar-List-Utils/lib/List/Util/XS.pm b/cpan/Scalar-List-Utils/lib/List/Util/XS.pm index f2e01ae94b..d196ce26fa 100644 --- a/cpan/Scalar-List-Utils/lib/List/Util/XS.pm +++ b/cpan/Scalar-List-Utils/lib/List/Util/XS.pm @@ -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; diff --git a/cpan/Scalar-List-Utils/lib/Scalar/Util.pm b/cpan/Scalar-List-Utils/lib/Scalar/Util.pm index 3f17d13b83..8ac705edfe 100644 --- a/cpan/Scalar-List-Utils/lib/Scalar/Util.pm +++ b/cpan/Scalar-List-Utils/lib/Scalar/Util.pm @@ -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) { diff --git a/cpan/Scalar-List-Utils/lib/Sub/Util.pm b/cpan/Scalar-List-Utils/lib/Sub/Util.pm index e40cf2205e..a276d952f9 100644 --- a/cpan/Scalar-List-Utils/lib/Sub/Util.pm +++ b/cpan/Scalar-List-Utils/lib/Sub/Util.pm @@ -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 diff --git a/cpan/Scalar-List-Utils/t/pair.t b/cpan/Scalar-List-Utils/t/pair.t index fab05dd158..81acf06594 100644 --- a/cpan/Scalar-List-Utils/t/pair.t +++ b/cpan/Scalar-List-Utils/t/pair.t @@ -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' ); diff --git a/cpan/Scalar-List-Utils/t/refaddr.t b/cpan/Scalar-List-Utils/t/refaddr.t index c208943fcf..8d7c441bb3 100644 --- a/cpan/Scalar-List-Utils/t/refaddr.t +++ b/cpan/Scalar-List-Utils/t/refaddr.t @@ -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); diff --git a/pod/perldelta.pod b/pod/perldelta.pod index fb6bfc433b..3dea0cf24d 100644 --- a/pod/perldelta.pod +++ b/pod/perldelta.pod @@ -167,6 +167,10 @@ L<perl5db.pl> has been upgraded from version 1.49 to 1.49_01. User actions are no longer evaluated after the script under the debugger finishes. [perl #71678] +=item * + +The Scalar-List-Utils distribution has been upgraded from version 1.41 to 1.42. + =back =head2 Removed Modules and Pragmata |