In perl.git, the branch blead has been updated
<http://perl5.git.perl.org/perl.git/commitdiff/d1c21cecdd89e9b092d8df4a520111183a1d537a?hp=d408791feefd619096e6fd7ffe59e868e9359ef8>
- Log -----------------------------------------------------------------
commit d1c21cecdd89e9b092d8df4a520111183a1d537a
Author: Rafael Garcia-Suarez <r...@consttype.org>
Date: Thu Oct 22 22:39:45 2009 +0200
Remove file t/0 added by last commit
Make the test create it instead
M MANIFEST
D t/0
M t/op/while_readdir.t
commit 114c60ecb1f775ef1deb4fdc8fb8e3a6f343d13d
Author: Brad Gilbert <b2gi...@gmail.com>
Date: Thu Oct 22 22:03:40 2009 +0200
Bare readdir in while loop now sets $_
M AUTHORS
M MANIFEST
M op.c
M pod/perlfunc.pod
A t/0
A t/op/while_readdir.t
-----------------------------------------------------------------------
Summary of changes:
AUTHORS | 1 +
MANIFEST | 1 +
op.c | 12 +++--
pod/perlfunc.pod | 9 ++++
t/op/while_readdir.t | 124 ++++++++++++++++++++++++++++++++++++++++++++++++++
5 files changed, 143 insertions(+), 4 deletions(-)
create mode 100644 t/op/while_readdir.t
diff --git a/AUTHORS b/AUTHORS
index e7806c2..b973c24 100644
--- a/AUTHORS
+++ b/AUTHORS
@@ -126,6 +126,7 @@ Bob Wilkinson <b...@fourtheye.org>
Boris Zentner <b...@2bz.de>
Boyd Gerber <gerb...@zenez.com>
Brad Appleton <brad...@enteract.com>
+Brad Gilbert <b2gi...@gmail.com>
Brad Howerter <bho...@wgc.woodward.com>
Brad Hughes <b...@tgsmc.com>
Brad Lanam <b...@gentoo.com>
diff --git a/MANIFEST b/MANIFEST
index 3aad396..dd82c52 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -4457,6 +4457,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
--- 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
--- 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/op/while_readdir.t b/t/op/while_readdir.t
new file mode 100644
index 0000000..851c6d7
--- /dev/null
+++ b/t/op/while_readdir.t
@@ -0,0 +1,124 @@
+#!./perl
+
+BEGIN {
+ chdir 't' if -d 't';
+ @INC = '../lib';
+ require './test.pl';
+}
+
+use strict;
+use warnings;
+
+open my $fh, ">", "0" or die "Can't open '0' for writing: $!\n";
+print $fh <<'FILE0';
+This file is here for testing
+
+while(readdir $dir){...}
+... while readdir $dir
+
+etc
+FILE0
+close $fh;
+
+plan 10;
+
+ok(-f '0', "'0' file is here");
+
+opendir my $dirhandle, '.'
+ or die "Failed test: unable to open directory: $!\n";
+
+my @dir = readdir $dirhandle;
+rewinddir $dirhandle;
+
+{
+ 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;
+}
+
+{
+ 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;
+
+END { 1 while unlink "0" }
--
Perl5 Master Repository
