xref: /openbsd/gnu/usr.bin/perl/lib/DirHandle.t (revision 256a93a4) 
1#!./perl
2
3BEGIN {
4    chdir 't' if -d 't';
5    @INC = '../lib';
6    require Config; import Config;
7    if (not $Config{'d_readdir'}) {
8	print "1..0\n";
9	exit 0;
10    }
11}
12
13use DirHandle;
14use Test::More;
15
16# Fetching the list of files in two different ways and expecting them
17# to be the same is a race condition when tests are running in parallel.
18# So go somewhere quieter.
19my $chdir;
20if ($ENV{PERL_CORE} && -d 'uni') {
21  chdir 'uni';
22  push @INC, '../../lib';
23  $chdir++;
24};
25
26$dot = DirHandle->new('.');
27
28ok(defined $dot, "DirHandle->new returns defined value");
29isa_ok($dot, 'DirHandle');
30
31@a = sort <*>;
32do { $first = $dot->read } while defined($first) && $first =~ /^\./;
33ok(+(grep { $_ eq $first } @a),
34    "Scalar context: First non-dot entry returned by 'read' is found in glob");
35
36@b = sort($first, (grep {/^[^.]/} $dot->read));
37ok(+(join("\0", @a) eq join("\0", @b)),
38    "List context: Remaining entries returned by 'read' match glob");
39
40ok($dot->rewind, "'rewind' method returns true value");
41@c = sort grep {/^[^.]/} $dot->read;
42cmp_ok(join("\0", @b), 'eq', join("\0", @c),
43    "After 'rewind', directory re-read as expected");
44
45ok($dot->close, "'close' method returns true value");
46$dot->rewind;
47ok(! defined $dot->read,
48    "Having closed the directory handle -- and notwithstanding invocation of 'rewind' -- 'read' returns undefined value");
49
50{
51    local $@;
52    eval { $redot = DirHandle->new( '.', '..' ); };
53    like($@, qr/^usage/,
54        "DirHandle constructor with too many arguments fails as expected");
55}
56
57# Now let's test with directory argument provided to 'open' rather than 'new'
58
59$redot = DirHandle->new();
60ok(defined $redot, "DirHandle->new returns defined value even without provided argument");
61isa_ok($redot, 'DirHandle');
62ok($redot->open('.'), "Explicit call of 'open' method returns true value");
63do { $first = $redot->read } while defined($first) && $first =~ /^\./;
64ok(+(grep { $_ eq $first } @a),
65    "Scalar context: First non-dot entry returned by 'read' is found in glob");
66
67@b = sort($first, (grep {/^[^.]/} $redot->read));
68ok(+(join("\0", @a) eq join("\0", @b)),
69    "List context: Remaining entries returned by 'read' match glob");
70
71ok($redot->rewind, "'rewind' method returns true value");
72@c = sort grep {/^[^.]/} $redot->read;
73cmp_ok(join("\0", @b), 'eq', join("\0", @c),
74    "After 'rewind', directory re-read as expected");
75
76ok($redot->close, "'close' method returns true value");
77$redot->rewind;
78ok(! defined $redot->read,
79    "Having closed the directory handle -- and notwithstanding invocation of 'rewind' -- 'read' returns undefined value");
80
81$undot = DirHandle->new('foobar');
82ok(! defined $undot,
83    "Constructor called with non-existent directory returns undefined value");
84
85# Test error conditions for various methods
86
87$aadot = DirHandle->new();
88ok(defined $aadot, "DirHandle->new returns defined value even without provided argument");
89isa_ok($aadot, 'DirHandle');
90{
91    local $@;
92    eval { $aadot->open('.', '..'); };
93    like($@, qr/^usage/,
94        "'open' called with too many arguments fails as expected");
95}
96ok($aadot->open('.'), "Explicit call of 'open' method returns true value");
97{
98    local $@;
99    eval { $aadot->read('foobar'); };
100    like($@, qr/^usage/,
101        "'read' called with argument fails as expected");
102}
103{
104    local $@;
105    eval { $aadot->close('foobar'); };
106    like($@, qr/^usage/,
107        "'close' called with argument fails as expected");
108}
109{
110    local $@;
111    eval { $aadot->rewind('foobar'); };
112    like($@, qr/^usage/,
113        "'rewind' called with argument fails as expected");
114}
115
116{
117    local $@;
118    eval { $bbdot = DirHandle::new(); };
119    like($@, qr/^usage/,
120        "DirHandle called as function but with no arguments fails as expected");
121}
122
123$bbdot = DirHandle->new();
124ok(! $bbdot->open('foobar'),
125    "Calling open method on nonexistent directory returns false value");
126ok(! $bbdot->read(),
127    "Calling read method after failed open method returns false value");
128ok(! $bbdot->rewind(),
129    "Calling rewind method after failed open method returns false value");
130ok(! $bbdot->close(),
131    "Calling close method after failed open method returns false value");
132
133if ($chdir) {
134  chdir "..";
135}
136
137done_testing();
138