mktables: Improve warning message

[perl5.git] / lib / DirHandle.t

#!./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 "..";
}