Move IO from ext/ to dist/
[perl.git] / dist / IO / t / io_dir.t
1 #!./perl
2
3 BEGIN {
4     if ($ENV{PERL_CORE}) {
5         require Config; import Config;
6         if ($] < 5.00326 || not $Config{'d_readdir'}) {
7             print "1..0 # Skip: readdir() not available\n";
8             exit 0;
9         }
10     }
11
12     require($ENV{PERL_CORE} ? "../../t/test.pl" : "./t/test.pl");
13     plan(16);
14
15     use_ok('IO::Dir');
16     IO::Dir->import(DIR_UNLINK);
17 }
18
19 use strict;
20
21 my $DIR = $^O eq 'MacOS' ? ":" : ".";
22
23 my $CLASS = "IO::Dir";
24 my $dot = $CLASS->new($DIR);
25 ok(defined($dot));
26
27 my @a = sort <*>;
28 my $first;
29 do { $first = $dot->read } while defined($first) && $first =~ /^\./;
30 ok(+(grep { $_ eq $first } @a));
31
32 my @b = sort($first, (grep {/^[^.]/} $dot->read));
33 ok(+(join("\0", @a) eq join("\0", @b)));
34
35 ok($dot->rewind,'rewind');
36 my @c = sort grep {/^[^.]/} $dot->read;
37 ok(+(join("\0", @b) eq join("\0", @c)));
38
39 ok($dot->close,'close');
40 { local $^W; # avoid warnings on invalid dirhandle
41 ok(!$dot->rewind, "rewind on closed");
42 ok(!defined($dot->read));
43 }
44
45 open(FH,'>X') || die "Can't create x";
46 print FH "X";
47 close(FH) or die "Can't close: $!";
48
49 my %dir;
50 tie %dir, $CLASS, $DIR;
51 my @files = keys %dir;
52
53 # I hope we do not have an empty dir :-)
54 ok(scalar @files);
55
56 my $stat = $dir{'X'};
57 isa_ok($stat,'File::stat');
58 ok(defined($stat) && $stat->size == 1);
59
60 delete $dir{'X'};
61
62 ok(-f 'X');
63
64 my %dirx;
65 tie %dirx, $CLASS, $DIR, DIR_UNLINK;
66
67 my $statx = $dirx{'X'};
68 isa_ok($statx,'File::stat');
69 ok(defined($statx) && $statx->size == 1);
70
71 delete $dirx{'X'};
72
73 ok(!(-f 'X'));