In perl.git, the branch blead has been updated

<http://perl5.git.perl.org/perl.git/commitdiff/e1817ab9e1b3103a20f0236757fcabee412a82f7?hp=25f5d540536c9ee920ad9bdc29e43e3284465acb>

- Log -----------------------------------------------------------------
commit e1817ab9e1b3103a20f0236757fcabee412a82f7
Author: Father Chrysostomos <[email protected]>
Date:   Sat Oct 25 11:56:12 2014 -0700

    perldata: Document list repetition assignment

M       pod/perldata.pod

commit 82209a5d9db5f107d86440d96503ab28e816bc5e
Author: Father Chrysostomos <[email protected]>
Date:   Sat Oct 25 11:49:57 2014 -0700

    Allow list assignment to list repetition
    
    (undef,undef,undef,$foo,$bar)=that_function();
    
    can now be written as
    
    ((undef)x3, $foo, $bar) = that_function();
    
    Furthermore, (($a)x$assign_to_a,$b) = @c will include $a in the list
    of variables ta assign to if $assign_to_a is 1, assign $c[0] to $b
    if $assign_to_a is 0.  In other words, assuming $assign_to_a is 1 or
    0, it is equivalent to:
    
    ($assign_to_a ? ($a, $b) : $b) = @c

M       op.c
M       t/op/repeat.t
-----------------------------------------------------------------------

Summary of changes:
 op.c             | 31 ++++++++++++++++++++++++++++++-
 pod/perldata.pod |  4 ++++
 t/op/repeat.t    |  9 ++++++++-
 3 files changed, 42 insertions(+), 2 deletions(-)

diff --git a/op.c b/op.c
index 329115c..646433e 100644
--- a/op.c
+++ b/op.c
@@ -2599,7 +2599,6 @@ Perl_op_lvalue_flags(pTHX_ OP *o, I32 type, U32 flags)
     case OP_MULTIPLY:
     case OP_DIVIDE:
     case OP_MODULO:
-    case OP_REPEAT:
     case OP_ADD:
     case OP_SUBTRACT:
     case OP_CONCAT:
@@ -2618,6 +2617,36 @@ Perl_op_lvalue_flags(pTHX_ OP *o, I32 type, U32 flags)
        PL_modcount++;
        break;
 
+    case OP_REPEAT:
+       if (o->op_flags & OPf_STACKED) {
+           PL_modcount++;
+           break;
+       }
+       if (type != OP_AASSIGN || !(o->op_private & OPpREPEAT_DOLIST))
+           goto nomod;
+       else {
+           const I32 mods = PL_modcount;
+           if (cBINOPo->op_last) {
+               modkids(cBINOPo->op_first, OP_AASSIGN);
+               kid = cBINOPo->op_last;
+           }
+           else {
+               kid = OP_SIBLING(cUNOPx(cBINOPo->op_first)->op_first);
+               for (; OP_HAS_SIBLING(kid); kid = OP_SIBLING(kid))
+                   op_lvalue(kid, OP_AASSIGN);
+               assert(kid == cLISTOPx(cBINOPo->op_first)->op_last);
+           }
+           if (kid->op_type == OP_CONST && SvIOK(kSVOP_sv)) {
+               const iv = SvIV(kSVOP_sv);
+               if (PL_modcount != RETURN_UNLIMITED_NUMBER)
+                   PL_modcount =
+                       mods + (PL_modcount - mods) * (iv < 0 ? 0 : iv);
+           }
+           else
+               PL_modcount = RETURN_UNLIMITED_NUMBER;
+       }
+       break;
+
     case OP_COND_EXPR:
        localize = 1;
        for (kid = OP_SIBLING(cUNOPo->op_first); kid; kid = OP_SIBLING(kid))
diff --git a/pod/perldata.pod b/pod/perldata.pod
index b0f5e7e..436f135 100644
--- a/pod/perldata.pod
+++ b/pod/perldata.pod
@@ -718,6 +718,10 @@ function:
 
     ($dev, $ino, undef, undef, $uid, $gid) = stat($file);
 
+As of Perl 5.22, you can also use C<(undef)x2> instead of C<undef, undef>.
+(You can also do C<($x) x 2>, which is less useful, because it assigns to
+the same variable twice, clobbering the first value assigned.)
+
 List assignment in scalar context returns the number of elements
 produced by the expression on the right side of the assignment:
 
diff --git a/t/op/repeat.t b/t/op/repeat.t
index aa15f24..03391c1 100644
--- a/t/op/repeat.t
+++ b/t/op/repeat.t
@@ -6,7 +6,7 @@ BEGIN {
 }
 
 require './test.pl';
-plan(tests => 42);
+plan(tests => 45);
 
 # compile time
 
@@ -64,6 +64,13 @@ is(join('', (split(//,"123")) x 2), '123123',       'split 
and x');
 is(join('', @x x -12),      '',                     '@x x -12');
 is(join('', (@x) x -14),    '',                     '(@x) x -14');
 
+($a, (undef)x5, $b) = 1..10;
+is ("$a $b", "1 7", '(undef)xCONST on lhs of list assignment');
+(($a)x3,$b) = 1..10;
+is ("$a, $b", "3, 4", '($x)xCONST on lhs of list assignment');
+($a, (undef)x${\6}, $b) = "a".."z";
+is ("$a$b", "ah", '(undef)x$foo on lhs of list assignment');
+
 
 # This test is actually testing for Digital C compiler optimizer bug,
 # present in Dec C versions 5.* and 6.0 (used in Digital UNIX and VMS),

--
Perl5 Master Repository

Reply via email to