155745691Smillert#!./perl 255745691Smillert 355745691SmillertBEGIN { 455745691Smillert chdir 't' if -d 't'; 555745691Smillert @INC = '../lib'; 655745691Smillert require Config; import Config; 755745691Smillert if (not $Config{'d_readdir'}) { 855745691Smillert print "1..0\n"; 955745691Smillert exit 0; 1055745691Smillert } 1155745691Smillert} 1255745691Smillert 1355745691Smillertuse DirHandle; 14*256a93a4Safresh1use Test::More; 1555745691Smillert 1643003dfeSmillert# Fetching the list of files in two different ways and expecting them 1743003dfeSmillert# to be the same is a race condition when tests are running in parallel. 1843003dfeSmillert# So go somewhere quieter. 1943003dfeSmillertmy $chdir; 2043003dfeSmillertif ($ENV{PERL_CORE} && -d 'uni') { 2143003dfeSmillert chdir 'uni'; 22898184e3Ssthen push @INC, '../../lib'; 2343003dfeSmillert $chdir++; 2443003dfeSmillert}; 2543003dfeSmillert 26898184e3Ssthen$dot = DirHandle->new('.'); 2755745691Smillert 285759b3d2Safresh1ok(defined $dot, "DirHandle->new returns defined value"); 295759b3d2Safresh1isa_ok($dot, 'DirHandle'); 3055745691Smillert 3155745691Smillert@a = sort <*>; 3255745691Smillertdo { $first = $dot->read } while defined($first) && $first =~ /^\./; 335759b3d2Safresh1ok(+(grep { $_ eq $first } @a), 345759b3d2Safresh1 "Scalar context: First non-dot entry returned by 'read' is found in glob"); 3555745691Smillert 3655745691Smillert@b = sort($first, (grep {/^[^.]/} $dot->read)); 375759b3d2Safresh1ok(+(join("\0", @a) eq join("\0", @b)), 385759b3d2Safresh1 "List context: Remaining entries returned by 'read' match glob"); 3955745691Smillert 405759b3d2Safresh1ok($dot->rewind, "'rewind' method returns true value"); 4155745691Smillert@c = sort grep {/^[^.]/} $dot->read; 425759b3d2Safresh1cmp_ok(join("\0", @b), 'eq', join("\0", @c), 435759b3d2Safresh1 "After 'rewind', directory re-read as expected"); 4455745691Smillert 455759b3d2Safresh1ok($dot->close, "'close' method returns true value"); 4655745691Smillert$dot->rewind; 475759b3d2Safresh1ok(! defined $dot->read, 485759b3d2Safresh1 "Having closed the directory handle -- and notwithstanding invocation of 'rewind' -- 'read' returns undefined value"); 495759b3d2Safresh1 505759b3d2Safresh1{ 515759b3d2Safresh1 local $@; 525759b3d2Safresh1 eval { $redot = DirHandle->new( '.', '..' ); }; 535759b3d2Safresh1 like($@, qr/^usage/, 545759b3d2Safresh1 "DirHandle constructor with too many arguments fails as expected"); 555759b3d2Safresh1} 565759b3d2Safresh1 575759b3d2Safresh1# Now let's test with directory argument provided to 'open' rather than 'new' 585759b3d2Safresh1 595759b3d2Safresh1$redot = DirHandle->new(); 605759b3d2Safresh1ok(defined $redot, "DirHandle->new returns defined value even without provided argument"); 615759b3d2Safresh1isa_ok($redot, 'DirHandle'); 625759b3d2Safresh1ok($redot->open('.'), "Explicit call of 'open' method returns true value"); 635759b3d2Safresh1do { $first = $redot->read } while defined($first) && $first =~ /^\./; 645759b3d2Safresh1ok(+(grep { $_ eq $first } @a), 655759b3d2Safresh1 "Scalar context: First non-dot entry returned by 'read' is found in glob"); 665759b3d2Safresh1 675759b3d2Safresh1@b = sort($first, (grep {/^[^.]/} $redot->read)); 685759b3d2Safresh1ok(+(join("\0", @a) eq join("\0", @b)), 695759b3d2Safresh1 "List context: Remaining entries returned by 'read' match glob"); 705759b3d2Safresh1 715759b3d2Safresh1ok($redot->rewind, "'rewind' method returns true value"); 725759b3d2Safresh1@c = sort grep {/^[^.]/} $redot->read; 735759b3d2Safresh1cmp_ok(join("\0", @b), 'eq', join("\0", @c), 745759b3d2Safresh1 "After 'rewind', directory re-read as expected"); 755759b3d2Safresh1 765759b3d2Safresh1ok($redot->close, "'close' method returns true value"); 775759b3d2Safresh1$redot->rewind; 785759b3d2Safresh1ok(! defined $redot->read, 795759b3d2Safresh1 "Having closed the directory handle -- and notwithstanding invocation of 'rewind' -- 'read' returns undefined value"); 805759b3d2Safresh1 815759b3d2Safresh1$undot = DirHandle->new('foobar'); 825759b3d2Safresh1ok(! defined $undot, 835759b3d2Safresh1 "Constructor called with non-existent directory returns undefined value"); 845759b3d2Safresh1 855759b3d2Safresh1# Test error conditions for various methods 865759b3d2Safresh1 875759b3d2Safresh1$aadot = DirHandle->new(); 885759b3d2Safresh1ok(defined $aadot, "DirHandle->new returns defined value even without provided argument"); 895759b3d2Safresh1isa_ok($aadot, 'DirHandle'); 905759b3d2Safresh1{ 915759b3d2Safresh1 local $@; 925759b3d2Safresh1 eval { $aadot->open('.', '..'); }; 935759b3d2Safresh1 like($@, qr/^usage/, 945759b3d2Safresh1 "'open' called with too many arguments fails as expected"); 955759b3d2Safresh1} 965759b3d2Safresh1ok($aadot->open('.'), "Explicit call of 'open' method returns true value"); 975759b3d2Safresh1{ 985759b3d2Safresh1 local $@; 995759b3d2Safresh1 eval { $aadot->read('foobar'); }; 1005759b3d2Safresh1 like($@, qr/^usage/, 1015759b3d2Safresh1 "'read' called with argument fails as expected"); 1025759b3d2Safresh1} 1035759b3d2Safresh1{ 1045759b3d2Safresh1 local $@; 1055759b3d2Safresh1 eval { $aadot->close('foobar'); }; 1065759b3d2Safresh1 like($@, qr/^usage/, 1075759b3d2Safresh1 "'close' called with argument fails as expected"); 1085759b3d2Safresh1} 1095759b3d2Safresh1{ 1105759b3d2Safresh1 local $@; 1115759b3d2Safresh1 eval { $aadot->rewind('foobar'); }; 1125759b3d2Safresh1 like($@, qr/^usage/, 1135759b3d2Safresh1 "'rewind' called with argument fails as expected"); 1145759b3d2Safresh1} 1155759b3d2Safresh1 1165759b3d2Safresh1{ 1175759b3d2Safresh1 local $@; 1185759b3d2Safresh1 eval { $bbdot = DirHandle::new(); }; 1195759b3d2Safresh1 like($@, qr/^usage/, 1205759b3d2Safresh1 "DirHandle called as function but with no arguments fails as expected"); 1215759b3d2Safresh1} 1225759b3d2Safresh1 1235759b3d2Safresh1$bbdot = DirHandle->new(); 1245759b3d2Safresh1ok(! $bbdot->open('foobar'), 1255759b3d2Safresh1 "Calling open method on nonexistent directory returns false value"); 1265759b3d2Safresh1ok(! $bbdot->read(), 1275759b3d2Safresh1 "Calling read method after failed open method returns false value"); 1285759b3d2Safresh1ok(! $bbdot->rewind(), 1295759b3d2Safresh1 "Calling rewind method after failed open method returns false value"); 1305759b3d2Safresh1ok(! $bbdot->close(), 1315759b3d2Safresh1 "Calling close method after failed open method returns false value"); 13243003dfeSmillert 13343003dfeSmillertif ($chdir) { 13443003dfeSmillert chdir ".."; 13543003dfeSmillert} 136*256a93a4Safresh1 137*256a93a4Safresh1done_testing(); 138