From 52102bb4f956712224c10b76771f133d3fbbb803 Mon Sep 17 00:00:00 2001 From: Steve Hay Date: Sun, 13 Oct 2013 16:26:44 +0100 Subject: [PATCH] Upgrade Scalar-List-Utils from version 1.32 to 1.33 --- Porting/Maintainers.pl | 2 +- cpan/List-Util/Changes | 5 +++ cpan/List-Util/ListUtil.xs | 61 ++++++++++++++++++++++++++++++++++++ cpan/List-Util/lib/List/Util.pm | 64 +++++++++++++++++++++++++++----------- cpan/List-Util/lib/List/Util/XS.pm | 2 +- cpan/List-Util/lib/Scalar/Util.pm | 2 +- pod/perldelta.pod | 7 +++++ 7 files changed, 122 insertions(+), 21 deletions(-) diff --git a/Porting/Maintainers.pl b/Porting/Maintainers.pl index 60081f9..ebfc967 100755 --- a/Porting/Maintainers.pl +++ b/Porting/Maintainers.pl @@ -1370,7 +1370,7 @@ use File::Glob qw(:case); }, 'Scalar-List-Utils' => { - 'DISTRIBUTION' => 'PEVANS/Scalar-List-Utils-1.32.tar.gz', + 'DISTRIBUTION' => 'PEVANS/Scalar-List-Utils-1.33.tar.gz', 'FILES' => q[cpan/List-Util], 'EXCLUDED' => [ qr{^inc/Module/}, diff --git a/cpan/List-Util/Changes b/cpan/List-Util/Changes index 2c26c70..2c1de4d 100644 --- a/cpan/List-Util/Changes +++ b/cpan/List-Util/Changes @@ -1,3 +1,8 @@ +1.33 -- Sun Oct 13 01:35 UTC 2013 + + * Added any, all, none, notall list reduction functions + (inspired by List::MoreUtils) + 1.32 -- Sun Aug 31 23:48 UTC 2013 * Skip pairmap()'s MULTICALL implementation 5.8.9 / 5.10.0 as it doesn't diff --git a/cpan/List-Util/ListUtil.xs b/cpan/List-Util/ListUtil.xs index c89bd57..f99c4cb 100644 --- a/cpan/List-Util/ListUtil.xs +++ b/cpan/List-Util/ListUtil.xs @@ -342,6 +342,67 @@ CODE: #endif void +any(block,...) + SV * block +ALIAS: + all = 1 + none = 2 + notall = 3 +PROTOTYPE: &@ +PPCODE: +{ + int ret = (ix == 0 || ix == 3); + int invert = (ix == 1 || ix == 3); + GV *gv; + HV *stash; + SV **args = &PL_stack_base[ax]; + CV *cv = sv_2cv(block, &stash, &gv, 0); + if (cv == Nullcv) { + croak("Not a subroutine reference"); + } + + SAVESPTR(GvSV(PL_defgv)); +#ifdef dMULTICALL + if(!CvISXSUB(cv)) { + dMULTICALL; + I32 gimme = G_SCALAR; + int index; + + PUSH_MULTICALL(cv); + for(index = 1; index < items; index++) { + GvSV(PL_defgv) = args[index]; + + MULTICALL; + if (SvTRUEx(*PL_stack_sp) ^ invert) { + POP_MULTICALL; + ST(0) = newSViv(ret); + XSRETURN(1); + } + } + POP_MULTICALL; + } + else +#endif + { + int index; + for(index = 1; index < items; index++) { + dSP; + GvSV(PL_defgv) = args[index]; + + PUSHMARK(SP); + call_sv((SV*)cv, G_SCALAR); + if (SvTRUEx(*PL_stack_sp) ^ invert) { + ST(0) = newSViv(ret); + XSRETURN(1); + } + } + } + + ST(0) = newSViv(!ret); + XSRETURN(1); +} + +void pairfirst(block,...) SV * block PROTOTYPE: &@ diff --git a/cpan/List-Util/lib/List/Util.pm b/cpan/List-Util/lib/List/Util.pm index 042ef14..988ed72 100644 --- a/cpan/List-Util/lib/List/Util.pm +++ b/cpan/List-Util/lib/List/Util.pm @@ -12,14 +12,30 @@ use strict; require Exporter; our @ISA = qw(Exporter); -our @EXPORT_OK = qw(first min max minstr maxstr reduce sum sum0 shuffle pairmap pairgrep pairfirst pairs pairkeys pairvalues); -our $VERSION = "1.32"; +our @EXPORT_OK = qw( + all any first min max minstr maxstr none notall reduce sum sum0 shuffle + pairmap pairgrep pairfirst pairs pairkeys pairvalues +); +our $VERSION = "1.33"; our $XS_VERSION = $VERSION; $VERSION = eval $VERSION; require XSLoader; XSLoader::load('List::Util', $XS_VERSION); +sub import +{ + my $pkg = caller; + + # (RT88848) Touch the caller's $a and $b, to avoid the warning of + # Name "main::a" used only once: possible typo" warning + no strict 'refs'; + ${"${pkg}::a"} = ${"${pkg}::a"}; + ${"${pkg}::b"} = ${"${pkg}::b"}; + + goto &Exporter::import; +} + sub sum0 { return 0 unless @_; @@ -81,6 +97,34 @@ C being returned The remaining list-reduction functions are all specialisations of this generic idea. +=head2 any BLOCK LIST + +Similar to C in that it evaluates BLOCK setting C<$_> to each element +of LIST in turn. C returns true if any element makes the BLOCK return a +true value. If BLOCK never returns true or LIST was empty then it returns +false. + +Many cases of using C in a conditional can be written using C +instead, as it can short-circuit after the first true result. + + if( any { length > 10 } @strings ) { + # at least one string has more than 10 characters + } + +=head2 all BLOCK LIST + +Similar to C, except that it requires all elements of the LIST to make +the BLOCK return true. If any element returns false, then it returns true. If +the BLOCK never returns false or the LIST was empty then it returns true. + +=head2 none BLOCK LIST + +=head2 notall BLOCK LIST + +Similar to C and C, but with the return sense inverted. C +returns true if no value in the LIST causes the BLOCK to return true, and +C returns true if not all of the values do. + =head2 first BLOCK LIST Similar to C in that it evaluates BLOCK setting C<$_> to each element @@ -293,22 +337,6 @@ reduce.t failing. The following are additions that have been requested, but I have been reluctant to add due to them being very simple to implement in perl - # One argument is true - - sub any { $_ && return 1 for @_; 0 } - - # All arguments are true - - sub all { $_ || return 0 for @_; 1 } - - # All arguments are false - - sub none { $_ && return 0 for @_; 1 } - - # One argument is false - - sub notall { $_ || return 1 for @_; 0 } - # How many elements are true sub true { scalar grep { $_ } @_ } diff --git a/cpan/List-Util/lib/List/Util/XS.pm b/cpan/List-Util/lib/List/Util/XS.pm index d9916bd..c479d1e 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.32"; # FIXUP +our $VERSION = "1.33"; # 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 7101c98..314da0e 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.32"; +our $VERSION = "1.33"; $VERSION = eval $VERSION; our @EXPORT_FAIL; diff --git a/pod/perldelta.pod b/pod/perldelta.pod index 70dcba7..52feeb5 100644 --- a/pod/perldelta.pod +++ b/pod/perldelta.pod @@ -181,6 +181,13 @@ Required versions of other modules used are now listed more explicitly. =item * +L has been upgraded from version 1.32 to 1.33. + +The list reduction functions C, C, C and C have been +added. + +=item * + L has been upgraded from version 2.99 to 3.00. The list of Perl versions covered has been updated. -- 2.7.4