xref: /openbsd/gnu/usr.bin/perl/dist/IO/t/io_dir.t (revision 8932bfb7)
1#!./perl
2
3BEGIN {
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
19use strict;
20
21my $DIR = $^O eq 'MacOS' ? ":" : ".";
22
23my $CLASS = "IO::Dir";
24my $dot = $CLASS->new($DIR);
25ok(defined($dot));
26
27my @a = sort <*>;
28my $first;
29do { $first = $dot->read } while defined($first) && $first =~ /^\./;
30ok(+(grep { $_ eq $first } @a));
31
32my @b = sort($first, (grep {/^[^.]/} $dot->read));
33ok(+(join("\0", @a) eq join("\0", @b)));
34
35ok($dot->rewind,'rewind');
36my @c = sort grep {/^[^.]/} $dot->read;
37ok(+(join("\0", @b) eq join("\0", @c)));
38
39ok($dot->close,'close');
40{ local $^W; # avoid warnings on invalid dirhandle
41ok(!$dot->rewind, "rewind on closed");
42ok(!defined($dot->read));
43}
44
45open(FH,'>X') || die "Can't create x";
46print FH "X";
47close(FH) or die "Can't close: $!";
48
49my %dir;
50tie %dir, $CLASS, $DIR;
51my @files = keys %dir;
52
53# I hope we do not have an empty dir :-)
54ok(scalar @files);
55
56my $stat = $dir{'X'};
57isa_ok($stat,'File::stat');
58ok(defined($stat) && $stat->size == 1);
59
60delete $dir{'X'};
61
62ok(-f 'X');
63
64my %dirx;
65tie %dirx, $CLASS, $DIR, DIR_UNLINK;
66
67my $statx = $dirx{'X'};
68isa_ok($statx,'File::stat');
69ok(defined($statx) && $statx->size == 1);
70
71delete $dirx{'X'};
72
73ok(!(-f 'X'));
74