#!./perl
BEGIN {
chdir
't'
if
-d
't'
;
@INC
=
'../lib'
;
require
Config;
import
Config;
if
(not
$Config
{
'd_readdir'
}) {
print
"1..0\n"
;
exit
0;
}
}
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"
);
}
$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"
);
$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
".."
;
}
done_testing();