t/lib/io_dir.t

   1 #!./perl
   2
   3 BEGIN {
   4     unless(grep /blib/, @INC) {
   5         chdir 't' if -d 't';
   6         @INC = '../lib';
   7     }
   8     require Config; import Config;
   9     if ($] < 5.00326 || not $Config{'d_readdir'}) {
  10         print "1..0\n";
  11         exit 0;
  12     }
  13 }
  14
  15 select(STDERR); $| = 1;
  16 select(STDOUT); $| = 1;
  17
  18 use IO::Dir qw(DIR_UNLINK);
  19
  20 print "1..10\n";
  21
  22 my $DIR = $^O eq 'MacOS' ? ":" : ".";
  23
  24 $dot = new IO::Dir $DIR;
  25 print defined($dot) ? "ok" : "not ok", " 1\n";
  26
  27 @a = sort <*>;
  28 do { $first = $dot->read } while defined($first) && $first =~ /^\./;
  29 print +(grep { $_ eq $first } @a) ? "ok" : "not ok", " 2\n";
  30
  31 @b = sort($first, (grep {/^[^.]/} $dot->read));
  32 print +(join("\0", @a) eq join("\0", @b)) ? "ok" : "not ok", " 3\n";
  33
  34 $dot->rewind;
  35 @c = sort grep {/^[^.]/} $dot->read;
  36 print +(join("\0", @b) eq join("\0", @c)) ? "ok" : "not ok", " 4\n";
  37
  38 $dot->close;
  39 $dot->rewind;
  40 print defined($dot->read) ? "not ok" : "ok", " 5\n";
  41
  42 open(FH,'>X') || die "Can't create x";
  43 print FH "X";
  44 close(FH);
  45
  46 tie %dir, IO::Dir, $DIR;
  47 my @files = keys %dir;
  48
  49 # I hope we do not have an empty dir :-)
  50 print @files ? "ok" : "not ok", " 6\n";
  51
  52 my $stat = $dir{'X'};
  53 print defined($stat) && UNIVERSAL::isa($stat,'File::stat') && $stat->size == 1
  54         ? "ok" : "not ok", " 7\n";
  55
  56 delete $dir{'X'};
  57
  58 print -f 'X' ? "ok" : "not ok", " 8\n";
  59
  60 tie %dirx, IO::Dir, $DIR, DIR_UNLINK;
  61
  62 my $statx = $dirx{'X'};
  63 print defined($statx) && UNIVERSAL::isa($statx,'File::stat') && $statx->size == 1
  64         ? "ok" : "not ok", " 9\n";
  65
  66 delete $dirx{'X'};
  67
  68 print -f 'X' ? "not ok" : "ok", " 10\n";