From: Brad Gilbert Date: Thu, 22 Oct 2009 20:03:40 +0000 (+0200) Subject: Bare readdir in while loop now sets $_ X-Git-Tag: v5.11.2~172 X-Git-Url: https://perl5.git.perl.org/perl5.git/commitdiff_plain/114c60ecb1f775ef1deb4fdc8fb8e3a6f343d13d?hp=d408791feefd619096e6fd7ffe59e868e9359ef8 Bare readdir in while loop now sets $_ --- diff --git a/AUTHORS b/AUTHORS index e7806c2..b973c24 100644 --- a/AUTHORS +++ b/AUTHORS @@ -126,6 +126,7 @@ Bob Wilkinson Boris Zentner Boyd Gerber Brad Appleton +Brad Gilbert Brad Howerter Brad Hughes Brad Lanam diff --git a/MANIFEST b/MANIFEST index 3aad396..009b5ec 100644 --- 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 --- 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 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 in a C 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 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 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;