Commit | Line | Data |
cf7fe8a2 |
1 | #!./perl |
2 | |
3 | BEGIN { |
4 | unless(grep /blib/, @INC) { |
5 | chdir 't' if -d 't'; |
93430cb4 |
6 | unshift @INC, '../lib' if -d '../lib'; |
cf7fe8a2 |
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 | $dot = new IO::Dir "."; |
23 | print defined($dot) ? "ok" : "not ok", " 1\n"; |
24 | |
25 | @a = sort <*>; |
26 | do { $first = $dot->read } while defined($first) && $first =~ /^\./; |
27 | print +(grep { $_ eq $first } @a) ? "ok" : "not ok", " 2\n"; |
28 | |
29 | @b = sort($first, (grep {/^[^.]/} $dot->read)); |
30 | print +(join("\0", @a) eq join("\0", @b)) ? "ok" : "not ok", " 3\n"; |
31 | |
32 | $dot->rewind; |
33 | @c = sort grep {/^[^.]/} $dot->read; |
34 | print +(join("\0", @b) eq join("\0", @c)) ? "ok" : "not ok", " 4\n"; |
35 | |
36 | $dot->close; |
37 | $dot->rewind; |
38 | print defined($dot->read) ? "not ok" : "ok", " 5\n"; |
39 | |
40 | open(FH,'>X') || die "Can't create x"; |
41 | print FH "X"; |
42 | close(FH); |
43 | |
44 | tie %dir, IO::Dir, "."; |
45 | my @files = keys %dir; |
46 | |
47 | # I hope we do not have an empty dir :-) |
48 | print @files ? "ok" : "not ok", " 6\n"; |
49 | |
50 | my $stat = $dir{'X'}; |
51 | print defined($stat) && UNIVERSAL::isa($stat,'File::stat') && $stat->size == 1 |
52 | ? "ok" : "not ok", " 7\n"; |
53 | |
54 | delete $dir{'X'}; |
55 | |
56 | print -f 'X' ? "ok" : "not ok", " 8\n"; |
57 | |
58 | tie %dirx, IO::Dir, ".", DIR_UNLINK; |
59 | |
60 | my $statx = $dirx{'X'}; |
61 | print defined($statx) && UNIVERSAL::isa($statx,'File::stat') && $statx->size == 1 |
62 | ? "ok" : "not ok", " 9\n"; |
63 | |
64 | delete $dirx{'X'}; |
65 | |
66 | print -f 'X' ? "not ok" : "ok", " 10\n"; |