This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Update Scalar-List-Utils to CPAN version 1.29
authorChris 'BinGOs' Williams <chris@bingosnet.co.uk>
Thu, 1 Aug 2013 20:07:00 +0000 (21:07 +0100)
committerChris 'BinGOs' Williams <chris@bingosnet.co.uk>
Thu, 1 Aug 2013 20:14:51 +0000 (21:14 +0100)
  [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

MANIFEST
Porting/Maintainers.pl
cpan/List-Util/Changes
cpan/List-Util/ListUtil.xs
cpan/List-Util/lib/List/Util.pm
cpan/List-Util/lib/List/Util/XS.pm
cpan/List-Util/lib/Scalar/Util.pm
cpan/List-Util/t/blessed.t
cpan/List-Util/t/pair.t [new file with mode: 0644]
pod/perldelta.pod

index 245d425..1b6f056 100644 (file)
--- 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
index e93604c..c8021a7 100755 (executable)
@@ -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],
index 9ab9804..032b4ef 100644 (file)
@@ -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
index 1ae74cd..d2f2f11 100644 (file)
@@ -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:
index 5988aa9..7801f6f 100644 (file)
@@ -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,
index 01b944b..e2167f8 100644 (file)
@@ -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;
index da22989..ddfa0ef 100644 (file)
@@ -26,7 +26,7 @@ our @EXPORT_OK = qw(
   tainted
   weaken
 );
-our $VERSION    = "1.27";
+our $VERSION    = "1.29";
 $VERSION   = eval $VERSION;
 
 our @EXPORT_FAIL;
index f0a4c19..1d448af 100644 (file)
@@ -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 (file)
index 0000000..f4c4289
--- /dev/null
@@ -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' );
index 515afda..940f183 100644 (file)
@@ -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 *