t/op/while_readdir.t

   1 #!./perl
   2
   3 BEGIN {
   4     chdir 't' if -d 't';
   5     @INC = '../lib';
   6     require './test.pl';
   7 }
   8
   9 use strict;
  10 use warnings;
  11
  12 plan 10;
  13
  14 # Need to run this in a quiet private directory as it assumes that it can read
  15 # the contents twice and get the same result.
  16 my $tempdir = tempfile;
  17
  18 mkdir $tempdir, 0700 or die "Can't mkdir '$tempdir': $!";
  19 chdir $tempdir or die die "Can't chdir '$tempdir': $!";
  20
  21 my $cleanup = 1;
  22 my %tempfiles;
  23
  24 END {
  25     if ($cleanup) {
  26         foreach my $file (keys %tempfiles) {
  27             # We only wrote each of these once so 1 delete should work:
  28             if (unlink $file) {
  29                 warn "unlink tempfile '$file' passed but it's still there"
  30                     if -e $file;
  31             } else {
  32                 warn "Couldn't unlink tempfile '$file': $!";
  33             }
  34         }
  35         chdir '..' or die "Couldn't chdir .. for cleanup: $!";
  36         rmdir $tempdir or die "Couldn't unlink tempdir '$tempdir': $!";
  37     }
  38 }
  39
  40 # This is intentionally not random (per run), but intentionally will try to
  41 # give different file names for different people running this test.
  42 srand $< * $];
  43
  44 my @chars = ('A' .. 'Z', 'a' .. 'z', 0 .. 9);
  45
  46 sub make_file {
  47     my $name = shift;
  48
  49     return if $tempfiles{$name}++;
  50
  51     print "# Writing to $name in $tempdir\n";
  52
  53     open my $fh, '>', $name or die "Can't open '$name' for writing: $!\n";
  54     print $fh <<'FILE0';
  55 This file is here for testing
  56
  57 while(readdir $dir){...}
  58 ... while readdir $dir
  59
  60 etc
  61 FILE0
  62     close $fh or die "Can't close '$name': $!";
  63 }
  64
  65 sub make_some_files {
  66     for (1..int rand 10) {
  67         my $name;
  68         $name .= $chars[rand $#chars] for 1..int(10 + rand 5);
  69         make_file($name);
  70     }
  71 }
  72
  73 make_some_files();
  74 make_file('0');
  75 make_some_files();
  76
  77 ok(-f '0', "'0' file is here");
  78
  79 opendir my $dirhandle, '.'
  80     or die "Failed test: unable to open directory: $!\n";
  81
  82 my @dir = readdir $dirhandle;
  83 rewinddir $dirhandle;
  84
  85 {
  86     my @list;
  87     while(readdir $dirhandle){
  88         push @list, $_;
  89     }
  90     ok( eq_array( \@dir, \@list ), 'while(readdir){push}' );
  91     rewinddir $dirhandle;
  92 }
  93
  94 {
  95     my @list;
  96     push @list, $_ while readdir $dirhandle;
  97     ok( eq_array( \@dir, \@list ), 'push while readdir' );
  98     rewinddir $dirhandle;
  99 }
 100
 101 {
 102     my $tmp;
 103     my @list;
 104     push @list, $tmp while $tmp = readdir $dirhandle;
 105     ok( eq_array( \@dir, \@list ), 'push $dir while $dir = readdir' );
 106     rewinddir $dirhandle;
 107 }
 108
 109 {
 110     my @list;
 111     while( my $dir = readdir $dirhandle){
 112         push @list, $dir;
 113     }
 114     ok( eq_array( \@dir, \@list ), 'while($dir=readdir){push}' );
 115     rewinddir $dirhandle;
 116 }
 117
 118
 119 {
 120     my @list;
 121     my $sub = sub{
 122         push @list, $_;
 123     };
 124     $sub->($_) while readdir $dirhandle;
 125     ok( eq_array( \@dir, \@list ), '$sub->($_) while readdir' );
 126     rewinddir $dirhandle;
 127 }
 128
 129 {
 130     my $works = 0;
 131     while(readdir $dirhandle){
 132         $_ =~ s/\.$// if defined $_ && $^O eq 'VMS'; # may have zero-length extension
 133         if( defined $_ && $_ eq '0'){
 134             $works = 1;
 135             last;
 136         }
 137     }
 138     ok( $works, 'while(readdir){} with file named "0"' );
 139     rewinddir $dirhandle;
 140 }
 141
 142 {
 143     my $works = 0;
 144     my $sub = sub{
 145         $_ =~ s/\.$// if defined $_ && $^O eq 'VMS'; # may have zero-length extension
 146         if( defined $_ && $_ eq '0' ){
 147             $works = 1;
 148         }
 149     };
 150     $sub->($_) while readdir $dirhandle;
 151     ok( $works, '$sub->($_) while readdir; with file named "0"' );
 152     rewinddir $dirhandle;
 153 }
 154
 155 {
 156     my $works = 0;
 157     while( my $dir = readdir $dirhandle ){
 158         $dir =~ s/\.$// if defined $dir && $^O eq 'VMS'; # may have zero-length extension
 159         if( defined $dir && $dir eq '0'){
 160             $works = 1;
 161             last;
 162         }
 163     }
 164     ok( $works, 'while($dir=readdir){} with file named "0"');
 165     rewinddir $dirhandle;
 166 }
 167
 168 {
 169     my $tmp;
 170     my $ok;
 171     my @list;
 172     while( $tmp = readdir $dirhandle ){
 173         $tmp =~ s/\.$// if defined $tmp && $^O eq 'VMS'; # may have zero-length extension
 174         last if defined($tmp)&& !$tmp && ($ok=1)
 175     }
 176     ok( $ok, '$dir while $dir = readdir; with file named "0"'  );
 177     rewinddir $dirhandle;
 178 }
 179
 180 closedir $dirhandle;