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