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 <[email protected]> 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 <[email protected]> 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 <[email protected]> Boris Zentner <[email protected]> Boyd Gerber <[email protected]> Brad Appleton <[email protected]> +Brad Gilbert <[email protected]> Brad Howerter <[email protected]> Brad Hughes <[email protected]> Brad Lanam <[email protected]> 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
