This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Add additional tests for DirHandle to improve coverage.
[perl5.git] / lib / DirHandle.t
CommitLineData
c07a80fd
PP
1#!./perl
2
3BEGIN {
4 chdir 't' if -d 't';
20822f61 5 @INC = '../lib';
c07a80fd 6 require Config; import Config;
1b4456a8 7 if (not $Config{'d_readdir'}) {
c07a80fd
PP
8 print "1..0\n";
9 exit 0;
10 }
11}
12
13use DirHandle;
a89c8284 14use Test::More tests => 31;
c07a80fd 15
ffe4764e
B
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';
5b88804b 22 push @INC, '../../lib';
ffe4764e
B
23 $chdir++;
24};
25
5b88804b 26$dot = DirHandle->new('.');
95e8664e 27
a89c8284
JK
28ok(defined $dot, "DirHandle->new returns defined value");
29isa_ok($dot, 'DirHandle');
c07a80fd 30
1b4456a8 31@a = sort <*>;
c07a80fd 32do { $first = $dot->read } while defined($first) && $first =~ /^\./;
a89c8284
JK
33ok(+(grep { $_ eq $first } @a),
34 "Scalar context: First non-dot entry returned by 'read' is found in glob");
c07a80fd
PP
35
36@b = sort($first, (grep {/^[^.]/} $dot->read));
a89c8284
JK
37ok(+(join("\0", @a) eq join("\0", @b)),
38 "List context: Remaining entries returned by 'read' match glob");
c07a80fd 39
a89c8284 40ok($dot->rewind, "'rewind' method returns true value");
c07a80fd 41@c = sort grep {/^[^.]/} $dot->read;
a89c8284
JK
42cmp_ok(join("\0", @b), 'eq', join("\0", @c),
43 "After 'rewind', directory re-read as expected");
c07a80fd 44
a89c8284 45ok($dot->close, "'close' method returns true value");
c07a80fd 46$dot->rewind;
a89c8284
JK
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");
ffe4764e
B
132
133if ($chdir) {
134 chdir "..";
135}