This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
upgrade Scalar-List-Utils from 1.47 to 1.48
authorDavid Mitchell <davem@iabyn.com>
Sat, 24 Jun 2017 08:16:02 +0000 (09:16 +0100)
committerDavid Mitchell <davem@iabyn.com>
Sat, 24 Jun 2017 08:16:02 +0000 (09:16 +0100)
[CHANGES]
 * Note in documentation that outer function's @_ can be accessed in
   some blocks, but ought not be (thanks wchristian)

[BUGFIXES]
 * Ensure pairmap extends its stack correctly (thanks davem)
 * Fix name of List::Util::unpairs in its error messages

Porting/Maintainers.pl
cpan/Scalar-List-Utils/ListUtil.xs
cpan/Scalar-List-Utils/lib/List/Util.pm
cpan/Scalar-List-Utils/lib/List/Util/XS.pm
cpan/Scalar-List-Utils/lib/Scalar/Util.pm
cpan/Scalar-List-Utils/lib/Sub/Util.pm
cpan/Scalar-List-Utils/t/pair.t

index 1fe22ba..340f1e3 100755 (executable)
@@ -959,7 +959,7 @@ use File::Glob qw(:case);
     },
 
     'Scalar-List-Utils' => {
-        'DISTRIBUTION' => 'PEVANS/Scalar-List-Utils-1.47.tar.gz',
+        'DISTRIBUTION' => 'PEVANS/Scalar-List-Utils-1.48.tar.gz',
         'FILES'        => q[cpan/Scalar-List-Utils],
     },
 
index 9db3804..2369919 100644 (file)
@@ -636,9 +636,9 @@ PPCODE:
         SvGETMAGIC(pair);
 
         if(SvTYPE(pair) != SVt_RV)
-            croak("Not a reference at List::Util::unpack() argument %d", i);
+            croak("Not a reference at List::Util::unpairs() argument %d", i);
         if(SvTYPE(SvRV(pair)) != SVt_PVAV)
-            croak("Not an ARRAY reference at List::Util::unpack() argument %d", i);
+            croak("Not an ARRAY reference at List::Util::unpairs() argument %d", i);
 
         /* TODO: assert pair is an ARRAY ref */
         pairav = (AV *)SvRV(pair);
@@ -905,6 +905,7 @@ PPCODE:
         SV **stack = PL_stack_base + ax;
         I32 ret_gimme = GIMME_V;
         int i;
+        AV *spill = NULL; /* accumulates results if too big for stack */
 
         dMULTICALL;
         I32 gimme = G_ARRAY;
@@ -914,41 +915,64 @@ PPCODE:
         for(; argi < items; argi += 2) {
             int count;
 
-            GvSV(agv) = args_copy ? args_copy[argi] : stack[argi];
-            GvSV(bgv) = argi < items-1 ?
-                (args_copy ? args_copy[argi+1] : stack[argi+1]) :
-                &PL_sv_undef;
+            GvSV(agv) = stack[argi];
+            GvSV(bgv) = argi < items-1 ? stack[argi+1]: &PL_sv_undef;
 
             MULTICALL;
             count = PL_stack_sp - PL_stack_base;
 
-            if(count > 2 && !args_copy) {
+            if (count > 2 || spill) {
                 /* 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.
+                 * without trashing the remaining arguments on the stack still
+                 * to be processed, or possibly overrunning the stack end.
+                 * So, we'll accumulate the results in a temporary buffer
+                 * 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(stack + argi, args_copy, n_args, SV *);
+                int fill;
+
+                if (!spill) {
+                    spill = newAV();
+                    AvREAL_off(spill); /* don't ref count its contents */
+                    /* can't mortalize here as every nextstate in the code
+                     * block frees temps */
+                    SAVEFREESV(spill);
+                }
 
-                argi = 0;
-                items = n_args;
+                fill = (int)AvFILL(spill);
+                av_extend(spill, fill + count);
+                for(i = 0; i < count; i++)
+                    (void)av_store(spill, ++fill,
+                                    newSVsv(PL_stack_base[i + 1]));
             }
-
-            for(i = 0; i < count; i++)
-                stack[reti++] = newSVsv(PL_stack_sp[i - count + 1]);
+            else
+                for(i = 0; i < count; i++)
+                    stack[reti++] = newSVsv(PL_stack_base[i + 1]);
         }
+
+        if (spill)
+            /* the POP_MULTICALL will trigger the SAVEFREESV above;
+             * keep it alive  it on the temps stack instead */
+            SvREFCNT_inc_simple_void_NN(spill);
+            sv_2mortal((SV*)spill);
+
         POP_MULTICALL;
 
+        if (spill) {
+            int n = (int)AvFILL(spill) + 1;
+            SP = &ST(reti - 1);
+            EXTEND(SP, n);
+            for (i = 0; i < n; i++)
+                *++SP = *av_fetch(spill, i, FALSE);
+            reti += n;
+            av_clear(spill);
+        }
+
         if(ret_gimme == G_ARRAY)
             for(i = 0; i < reti; i++)
-                sv_2mortal(stack[i]);
+                sv_2mortal(ST(i));
     }
     else
 #endif
index 47324ca..4a03af8 100644 (file)
@@ -15,7 +15,7 @@ our @EXPORT_OK  = qw(
   all any first min max minstr maxstr none notall product reduce sum sum0 shuffle uniq uniqnum uniqstr
   pairs unpairs pairkeys pairvalues pairmap pairgrep pairfirst
 );
-our $VERSION    = "1.47";
+our $VERSION    = "1.48";
 our $XS_VERSION = $VERSION;
 $VERSION    = eval $VERSION;
 
@@ -149,6 +149,9 @@ instead, as it can short-circuit after the first true result.
         # at least one string has more than 10 characters
     }
 
+Note: Due to XS issues the block passed may be able to access the outer @_
+directly. This is not intentional and will break under debugger.
+
 =head2 all
 
     my $bool = all { BLOCK } @list;
@@ -160,6 +163,9 @@ make the C<BLOCK> return true. If any element returns false, then it returns
 false. If the C<BLOCK> never returns false or the C<@list> was empty then it
 returns true.
 
+Note: Due to XS issues the block passed may be able to access the outer @_
+directly. This is not intentional and will break under debugger.
+
 =head2 none
 
 =head2 notall
@@ -174,6 +180,9 @@ Similar to L</any> and L</all>, but with the return sense inverted. C<none>
 returns true only if no value in the C<@list> causes the C<BLOCK> to return
 true, and C<notall> returns true only if not all of the values do.
 
+Note: Due to XS issues the block passed may be able to access the outer @_
+directly. This is not intentional and will break under debugger.
+
 =head2 first
 
     my $val = first { BLOCK } @list;
index a9e191f..c870411 100644 (file)
@@ -3,7 +3,7 @@ use strict;
 use warnings;
 use List::Util;
 
-our $VERSION = "1.47";       # FIXUP
+our $VERSION = "1.48";       # FIXUP
 $VERSION = eval $VERSION;    # FIXUP
 
 1;
index bd2b9ff..ad36af3 100644 (file)
@@ -17,7 +17,7 @@ our @EXPORT_OK = qw(
   dualvar isdual isvstring looks_like_number openhandle readonly set_prototype
   tainted
 );
-our $VERSION    = "1.47";
+our $VERSION    = "1.48";
 $VERSION   = eval $VERSION;
 
 require List::Util; # List::Util loads the XS
index 48f775f..b4ec6ac 100644 (file)
@@ -15,7 +15,7 @@ our @EXPORT_OK = qw(
   subname set_subname
 );
 
-our $VERSION    = "1.47";
+our $VERSION    = "1.48";
 $VERSION   = eval $VERSION;
 
 require List::Util; # as it has the XS
index 81acf06..e65123c 100644 (file)
@@ -3,7 +3,7 @@
 use strict;
 use warnings;
 
-use Test::More tests => 26;
+use Test::More tests => 27;
 use List::Util qw(pairgrep pairfirst pairmap pairs unpairs pairkeys pairvalues);
 
 no warnings 'misc'; # avoid "Odd number of elements" warnings most of the time
@@ -82,6 +82,16 @@ is_deeply( [ pairmap { my @l = (1) x 1000; "$a=$b" } one => 1, two => 2, three =
            [ "one=1", "two=2", "three=3" ],
            'pairmap copes with stack movement' );
 
+{
+    # do the pairmap and is_deeply as two separate statements to avoid
+    # the stack being extended before pairmap is called
+    my @a = pairmap { $a .. $b }
+                        1 => 3, 4 => 4, 5 => 6, 7 => 1998, 1999 => 2000;
+    my @exp; push @exp, $_ for 1..2000;
+    is_deeply( \@a, \@exp,
+           'pairmap result has more elements than input' );
+}
+
 is_deeply( [ pairs one => 1, two => 2, three => 3 ],
            [ [ one => 1 ], [ two => 2 ], [ three => 3 ] ],
            'pairs' );