Bare readdir in while loop now sets $_

diff --git a/AUTHORS b/AUTHORS
index e7806c2..b973c24 100644 (file)
--- a/AUTHORS
+++ b/AUTHORS
@@ -126,6 +126,7 @@ Bob Wilkinson                       <bob@fourtheye.org>
 Boris Zentner                  <bzm@2bz.de>
 Boyd Gerber                    <gerberb@zenez.com>
 Brad Appleton                  <bradapp@enteract.com>
+Brad Gilbert                   <b2gills@gmail.com>
 Brad Howerter                  <bhower@wgc.woodward.com>
 Brad Hughes                    <brad@tgsmc.com>
 Brad Lanam                     <bll@gentoo.com>

diff --git a/MANIFEST b/MANIFEST
index 3aad396..009b5ec 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -4137,6 +4137,7 @@ symbian/uid.pl                    Helper code for config.pl
 symbian/version.pl             Helper code for config.pl
 symbian/xsbuild.pl             Building extensions
 taint.c                                Tainting code
+t/0                            while(readdir) testing file
 t/base/cond.t                  See if conditionals work
 t/base/if.t                    See if if works
 t/base/lex.t                   See if lexical items work
@@ -4457,6 +4458,7 @@ t/op/utftaint.t                   See if utf8 and taint work together
 t/op/vec.t                     See if vectors work
 t/op/ver.t                     See if v-strings and the %v format flag work
 t/op/wantarray.t               See if wantarray works
+t/op/while_readdir.t           See if while(readdir) works
 t/op/write.t                   See if write works (formats work)
 t/op/yadayada.t                        See if ... works
 t/perl.supp                    Perl valgrind suppressions

diff --git a/op.c b/op.c
index d563282..e629a42 100644 (file)
--- a/op.c
+++ b/op.c
@@ -4784,7 +4784,9 @@ Perl_newLOOPOP(pTHX_ I32 flags, I32 debuggable, OP *expr, OP *block)
     if (expr) {
        if (once && expr->op_type == OP_CONST && !SvTRUE(((SVOP*)expr)->op_sv))
            return block;       /* do {} while 0 does once */
-       if (expr->op_type == OP_READLINE || expr->op_type == OP_GLOB
+       if (expr->op_type == OP_READLINE
+           || expr->op_type == OP_READDIR
+           || expr->op_type == OP_GLOB
            || (expr->op_type == OP_NULL && expr->op_targ == OP_GLOB)) {
            expr = newUNOP(OP_DEFINED, 0,
                newASSIGNOP(0, newDEFSVOP(), 0, expr) );
@@ -4793,7 +4795,7 @@ Perl_newLOOPOP(pTHX_ I32 flags, I32 debuggable, OP *expr, OP *block)
            const OP * const k2 = k1 ? k1->op_sibling : NULL;
            switch (expr->op_type) {
              case OP_NULL:
-               if (k2 && k2->op_type == OP_READLINE
+               if (k2 && (k2->op_type == OP_READLINE || k2->op_type == OP_READDIR)
                      && (k2->op_flags & OPf_STACKED)
                      && ((k1->op_flags & OPf_WANT) == OPf_WANT_SCALAR))
                    expr = newUNOP(OP_DEFINED, 0, expr);
@@ -4846,7 +4848,9 @@ whileline, OP *expr, OP *block, OP *cont, I32 has_my)
     PERL_UNUSED_ARG(debuggable);
 
     if (expr) {
-       if (expr->op_type == OP_READLINE || expr->op_type == OP_GLOB
+       if (expr->op_type == OP_READLINE
+         || expr->op_type == OP_READDIR
+         || expr->op_type == OP_GLOB
                     || (expr->op_type == OP_NULL && expr->op_targ == OP_GLOB)) {
            expr = newUNOP(OP_DEFINED, 0,
                newASSIGNOP(0, newDEFSVOP(), 0, expr) );
@@ -4855,7 +4859,7 @@ whileline, OP *expr, OP *block, OP *cont, I32 has_my)
            const OP * const k2 = (k1) ? k1->op_sibling : NULL;
            switch (expr->op_type) {
              case OP_NULL:
-               if (k2 && k2->op_type == OP_READLINE
+               if (k2 && (k2->op_type == OP_READLINE || k2->op_type == OP_READDIR)
                      && (k2->op_flags & OPf_STACKED)
                      && ((k1->op_flags & OPf_WANT) == OPf_WANT_SCALAR))
                    expr = newUNOP(OP_DEFINED, 0, expr);

diff --git a/pod/perlfunc.pod b/pod/perlfunc.pod
index fd8aa88..c440faa 100644 (file)
--- a/pod/perlfunc.pod
+++ b/pod/perlfunc.pod
@@ -4331,6 +4331,15 @@ C<chdir> there, it would have been testing the wrong file.
     @dots = grep { /^\./ && -f "$some_dir/$_" } readdir($dh);
     closedir $dh;
 
+As of Perl 5.11.2 you can use a bare C<readdir> in a C<while> loop,
+which will set C<$_> on every iteration.
+
+    opendir(my $dh, $some_dir) || die;
+    while(readdir $dh) {
+        print "$some_dir/$_\n";
+    }
+    closedir $dh;
+
 =item readline EXPR
 
 =item readline

diff --git a/t/0 b/t/0
new file mode 100644 (file)
index 0000000..689e8ce
--- /dev/null
+++ b/t/0
@@ -0,0 +1,6 @@
+This file is here for testing
+
+while(readdir $dir){...}
+... while readdir $dir
+
+etc

diff --git a/t/op/while_readdir.t b/t/op/while_readdir.t
new file mode 100644 (file)
index 0000000..740bfdd
--- /dev/null
+++ b/t/op/while_readdir.t
@@ -0,0 +1,115 @@
+#!./perl
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+    require './test.pl';
+}
+
+use strict;
+use warnings;
+
+opendir my $dirhandle, '.' or die "Failed test: unable to open directory\n";
+
+my @dir = readdir $dirhandle;
+rewinddir $dirhandle;
+
+plan 9;
+
+
+
+{
+    my @list;
+    while(readdir $dirhandle){
+       push @list, $_;
+    }
+    ok( eq_array( \@dir, \@list ), 'while(readdir){push}' );
+    rewinddir $dirhandle;
+}
+
+{
+    my @list;
+    push @list, $_ while readdir $dirhandle;
+    ok( eq_array( \@dir, \@list ), 'push while readdir' );
+    rewinddir $dirhandle;
+}
+
+{
+    my $tmp;
+    my @list;
+    push @list, $tmp while $tmp = readdir $dirhandle;
+    ok( eq_array( \@dir, \@list ), 'push $dir while $dir = readdir' );
+    rewinddir $dirhandle;
+}
+
+{
+    my @list;
+    while( my $dir = readdir $dirhandle){
+       push @list, $dir;
+    }
+    ok( eq_array( \@dir, \@list ), 'while($dir=readdir){push}' );
+    rewinddir $dirhandle;
+}
+
+
+{
+    my @list;
+    my $sub = sub{
+       push @list, $_;
+    };
+    $sub->($_) while readdir $dirhandle;
+    ok( eq_array( \@dir, \@list ), '$sub->($_) while readdir' );
+    rewinddir $dirhandle;
+}
+
+SKIP:{
+    skip ('No file named "0"',4) unless (scalar grep{ defined $_ && $_ eq '0' } @dir );
+    
+    {
+       my $works = 0;
+       while(readdir $dirhandle){
+           if( defined $_ && $_ eq '0'){
+               $works = 1;
+               last;
+           }
+       }
+       ok( $works, 'while(readdir){} with file named "0"' );
+       rewinddir $dirhandle;
+    }
+    
+    {
+       my $works = 0;
+       my $sub = sub{
+           if( defined $_ && $_ eq '0' ){
+               $works = 1;
+           }
+       };
+       $sub->($_) while readdir $dirhandle;
+       ok( $works, '$sub->($_) while readdir; with file named "0"' );
+       rewinddir $dirhandle;
+    }
+    
+    {
+       my $works = 0;
+       while( my $dir = readdir $dirhandle ){
+           if( defined $dir && $dir eq '0'){
+               $works = 1;
+               last;
+           }
+       }
+       ok( $works, 'while($dir=readdir){} with file named "0"');
+       rewinddir $dirhandle;
+    }
+
+    {
+        my $tmp;
+        my $ok;
+        my @list;
+        defined($tmp)&& !$tmp && ($ok=1) while $tmp = readdir $dirhandle;
+        ok( $ok, '$dir while $dir = readdir; with file named "0"'  );
+        rewinddir $dirhandle;
+    }
+
+}
+
+closedir $dirhandle;