ext/IO/t/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 # Skip: readdir() not available\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 my $tcount = 0;
  21
  22 sub ok {
  23   $tcount++;
  24   my $not = $_[0] ? '' : 'not ';
  25   print "${not}ok $tcount\n";
  26 }
  27
  28 print "1..10\n";
  29
  30 my $DIR = $^O eq 'MacOS' ? ":" : ".";
  31
  32 $dot = new IO::Dir $DIR;
  33 ok(defined($dot));
  34
  35 @a = sort <*>;
  36 do { $first = $dot->read } while defined($first) && $first =~ /^\./;
  37 ok(+(grep { $_ eq $first } @a));
  38
  39 @b = sort($first, (grep {/^[^.]/} $dot->read));
  40 ok(+(join("\0", @a) eq join("\0", @b)));
  41
  42 $dot->rewind;
  43 @c = sort grep {/^[^.]/} $dot->read;
  44 ok(+(join("\0", @b) eq join("\0", @c)));
  45
  46 $dot->close;
  47 $dot->rewind;
  48 ok(!defined($dot->read));
  49
  50 open(FH,'>X') || die "Can't create x";
  51 print FH "X";
  52 close(FH) or die "Can't close: $!";
  53
  54 tie %dir, IO::Dir, $DIR;
  55 my @files = keys %dir;
  56
  57 # I hope we do not have an empty dir :-)
  58 ok(scalar @files);
  59
  60 my $stat = $dir{'X'};
  61 ok(defined($stat) && UNIVERSAL::isa($stat,'File::stat') && $stat->size == 1);
  62
  63 delete $dir{'X'};
  64
  65 ok(-f 'X');
  66
  67 tie %dirx, IO::Dir, $DIR, DIR_UNLINK;
  68
  69 my $statx = $dirx{'X'};
  70 ok(defined($statx) && UNIVERSAL::isa($statx,'File::stat') && $statx->size == 1);
  71
  72 delete $dirx{'X'};
  73
  74 ok(!(-f 'X'));