Make while(each ...) imply defined($_ = ...)

This came up in ticket #108286.

Quoting Nicholas Clark:
>
>     while (<STDIN>)
>     while (<*>)
>
> These both always implicitly assigned to $_, always implicitly
> added defined.
>
>     while ($_ = <STDIN>)
>     while ($a = <STDIN>)
>     while ($_ = <*>)
>     while ($a = <*>)
>     while ($_ = readdir D)
>     while ($a = readdir D)
>     while ($_ = each %h)
>     while ($a = each %h)
>
> The implicit defined added was by commit 4b161ae29769b4a3,
> //depot/maint-5.004/perl@949
>
>
> BUT:
>
>     while (readdir D)
>
> The implicit assignment to $_ and defined test were both added in
> *2009* (by commit 114c60ecb1f7)
>
>
> leaving:
>
>     while (each %h)
>
>
> So it is the odd one out. And in 2009 we felt comfortable to add
> both the implicit assignment and the defined test in blead for
> readdir, as a bug fix, and have had no reports of it caus-
> ing problems.

[He asked:]
> > > So that's a bug?

[And I responded:]
> > That's what I was trying to ask. :-)
>
> OK, after a quite a bit of deliberation and digging, I'm of the opinion that
>
> 1: yes, it's a bug

...

> So, there's only one use of while(each %...) on CPAN outside of
> debugging or test code, and that's only go the potential to break
> due to assignment now happening to to $_. Compared with 29 matches
> for while\s*\(\s*readdir of which 4 are .pm files. So
>
> 2: I think it's safe to fix it, just like readdir was fixed.

Just *as* readdir was fixed! :-)

diff --git a/op.c b/op.c
index 1d199dc..339110d 100644 (file)
--- a/op.c
+++ b/op.c
@@ -5714,6 +5714,7 @@ Perl_newLOOPOP(pTHX_ I32 flags, I32 debuggable, OP *expr, OP *block)
        if (expr->op_type == OP_READLINE
            || expr->op_type == OP_READDIR
            || expr->op_type == OP_GLOB
+           || expr->op_type == OP_EACH || expr->op_type == OP_AEACH
            || (expr->op_type == OP_NULL && expr->op_targ == OP_GLOB)) {
            expr = newUNOP(OP_DEFINED, 0,
                newASSIGNOP(0, newDEFSVOP(), 0, expr) );
@@ -5803,6 +5804,7 @@ Perl_newWHILEOP(pTHX_ I32 flags, I32 debuggable, LOOP *loop,
        if (expr->op_type == OP_READLINE
          || expr->op_type == OP_READDIR
          || expr->op_type == OP_GLOB
+        || expr->op_type == OP_EACH || expr->op_type == OP_AEACH
                     || (expr->op_type == OP_NULL && expr->op_targ == OP_GLOB)) {
            expr = newUNOP(OP_DEFINED, 0,
                newASSIGNOP(0, newDEFSVOP(), 0, expr) );

diff --git a/t/op/defins.t b/t/op/defins.t
index 80127b4..5b26bf8 100644 (file)
--- a/t/op/defins.t
+++ b/t/op/defins.t
@@ -10,7 +10,7 @@ BEGIN {
     $SIG{__WARN__} = sub { $warns++; warn $_[0] };
 }
 require 'test.pl';
-plan( tests => 19 );
+plan( tests => 23 );
 
 my $unix_mode = 1;
 
@@ -132,6 +132,7 @@ unlink($saved_filename);
 ok(!(-f $saved_filename),'work file unlinked');
 
 my %hash = (0 => 1, 1 => 2);
+my @array = 1;
 
 $seen = 0;
 while (my $name = each %hash)
@@ -155,4 +156,30 @@ while ($where{$seen} = each %hash)
  }
 cmp_ok($seen,'==',1,'seen in each hash');
 
+$seen = 0;
+undef $_;
+while (each %hash)
+ {
+  $seen++ if $_ eq '0';
+ }
+cmp_ok($seen,'==',1,'0 seen in $_ in while(each %hash)');
+
+$seen = 0;
+undef $_;
+while (each @array)
+ {
+  $seen++ if $_ eq '0';
+ }
+cmp_ok($seen,'==',1,'0 seen in $_ in while(each @array)');
+
+$seen = 0;
+undef $_;
+$_ eq '0' and $seen++ while each %hash;
+cmp_ok($seen,'==',1,'0 seen in $_ in while(each %hash) as stm mod');
+
+$seen = 0;
+undef $_;
+$_ eq '0' and $seen++ while each @array;
+cmp_ok($seen,'==',1,'0 seen in $_ in while(each @array) as stm mod');
+
 cmp_ok($warns,'==',0,'no warns at finish');