136 lines
4.1 KiB
Perl
136 lines
4.1 KiB
Perl
#!./perl
|
|
|
|
BEGIN {
|
|
chdir 't' if -d 't';
|
|
@INC = '../lib';
|
|
require Config; import Config;
|
|
if (not $Config{'d_readdir'}) {
|
|
print "1..0\n";
|
|
exit 0;
|
|
}
|
|
}
|
|
|
|
use DirHandle;
|
|
use Test::More tests => 31;
|
|
|
|
# Fetching the list of files in two different ways and expecting them
|
|
# to be the same is a race condition when tests are running in parallel.
|
|
# So go somewhere quieter.
|
|
my $chdir;
|
|
if ($ENV{PERL_CORE} && -d 'uni') {
|
|
chdir 'uni';
|
|
push @INC, '../../lib';
|
|
$chdir++;
|
|
};
|
|
|
|
$dot = DirHandle->new('.');
|
|
|
|
ok(defined $dot, "DirHandle->new returns defined value");
|
|
isa_ok($dot, 'DirHandle');
|
|
|
|
@a = sort <*>;
|
|
do { $first = $dot->read } while defined($first) && $first =~ /^\./;
|
|
ok(+(grep { $_ eq $first } @a),
|
|
"Scalar context: First non-dot entry returned by 'read' is found in glob");
|
|
|
|
@b = sort($first, (grep {/^[^.]/} $dot->read));
|
|
ok(+(join("\0", @a) eq join("\0", @b)),
|
|
"List context: Remaining entries returned by 'read' match glob");
|
|
|
|
ok($dot->rewind, "'rewind' method returns true value");
|
|
@c = sort grep {/^[^.]/} $dot->read;
|
|
cmp_ok(join("\0", @b), 'eq', join("\0", @c),
|
|
"After 'rewind', directory re-read as expected");
|
|
|
|
ok($dot->close, "'close' method returns true value");
|
|
$dot->rewind;
|
|
ok(! defined $dot->read,
|
|
"Having closed the directory handle -- and notwithstanding invocation of 'rewind' -- 'read' returns undefined value");
|
|
|
|
{
|
|
local $@;
|
|
eval { $redot = DirHandle->new( '.', '..' ); };
|
|
like($@, qr/^usage/,
|
|
"DirHandle constructor with too many arguments fails as expected");
|
|
}
|
|
|
|
# Now let's test with directory argument provided to 'open' rather than 'new'
|
|
|
|
$redot = DirHandle->new();
|
|
ok(defined $redot, "DirHandle->new returns defined value even without provided argument");
|
|
isa_ok($redot, 'DirHandle');
|
|
ok($redot->open('.'), "Explicit call of 'open' method returns true value");
|
|
do { $first = $redot->read } while defined($first) && $first =~ /^\./;
|
|
ok(+(grep { $_ eq $first } @a),
|
|
"Scalar context: First non-dot entry returned by 'read' is found in glob");
|
|
|
|
@b = sort($first, (grep {/^[^.]/} $redot->read));
|
|
ok(+(join("\0", @a) eq join("\0", @b)),
|
|
"List context: Remaining entries returned by 'read' match glob");
|
|
|
|
ok($redot->rewind, "'rewind' method returns true value");
|
|
@c = sort grep {/^[^.]/} $redot->read;
|
|
cmp_ok(join("\0", @b), 'eq', join("\0", @c),
|
|
"After 'rewind', directory re-read as expected");
|
|
|
|
ok($redot->close, "'close' method returns true value");
|
|
$redot->rewind;
|
|
ok(! defined $redot->read,
|
|
"Having closed the directory handle -- and notwithstanding invocation of 'rewind' -- 'read' returns undefined value");
|
|
|
|
$undot = DirHandle->new('foobar');
|
|
ok(! defined $undot,
|
|
"Constructor called with non-existent directory returns undefined value");
|
|
|
|
# Test error conditions for various methods
|
|
|
|
$aadot = DirHandle->new();
|
|
ok(defined $aadot, "DirHandle->new returns defined value even without provided argument");
|
|
isa_ok($aadot, 'DirHandle');
|
|
{
|
|
local $@;
|
|
eval { $aadot->open('.', '..'); };
|
|
like($@, qr/^usage/,
|
|
"'open' called with too many arguments fails as expected");
|
|
}
|
|
ok($aadot->open('.'), "Explicit call of 'open' method returns true value");
|
|
{
|
|
local $@;
|
|
eval { $aadot->read('foobar'); };
|
|
like($@, qr/^usage/,
|
|
"'read' called with argument fails as expected");
|
|
}
|
|
{
|
|
local $@;
|
|
eval { $aadot->close('foobar'); };
|
|
like($@, qr/^usage/,
|
|
"'close' called with argument fails as expected");
|
|
}
|
|
{
|
|
local $@;
|
|
eval { $aadot->rewind('foobar'); };
|
|
like($@, qr/^usage/,
|
|
"'rewind' called with argument fails as expected");
|
|
}
|
|
|
|
{
|
|
local $@;
|
|
eval { $bbdot = DirHandle::new(); };
|
|
like($@, qr/^usage/,
|
|
"DirHandle called as function but with no arguments fails as expected");
|
|
}
|
|
|
|
$bbdot = DirHandle->new();
|
|
ok(! $bbdot->open('foobar'),
|
|
"Calling open method on nonexistent directory returns false value");
|
|
ok(! $bbdot->read(),
|
|
"Calling read method after failed open method returns false value");
|
|
ok(! $bbdot->rewind(),
|
|
"Calling rewind method after failed open method returns false value");
|
|
ok(! $bbdot->close(),
|
|
"Calling close method after failed open method returns false value");
|
|
|
|
if ($chdir) {
|
|
chdir "..";
|
|
}
|