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
old mode 100755 (executable)
new mode 100644 (file)
index e83ea13..2a131e6
@@ -11,24 +11,125 @@ BEGIN {
 }
 
 use DirHandle;
+use Test::More tests => 31;
 
-print "1..5\n";
+# 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 = new DirHandle ($^O eq 'MacOS' ? ':' : '.');
+$dot = DirHandle->new('.');
 
-print defined($dot) ? "ok" : "not ok", " 1\n";
+ok(defined $dot, "DirHandle->new returns defined value");
+isa_ok($dot, 'DirHandle');
 
 @a = sort <*>;
 do { $first = $dot->read } while defined($first) && $first =~ /^\./;
-print +(grep { $_ eq $first } @a) ? "ok" : "not ok", " 2\n";
+ok(+(grep { $_ eq $first } @a),
+    "Scalar context: First non-dot entry returned by 'read' is found in glob");
 
 @b = sort($first, (grep {/^[^.]/} $dot->read));
-print +(join("\0", @a) eq join("\0", @b)) ? "ok" : "not ok", " 3\n";
+ok(+(join("\0", @a) eq join("\0", @b)),
+    "List context: Remaining entries returned by 'read' match glob");
 
-$dot->rewind;
+ok($dot->rewind, "'rewind' method returns true value");
 @c = sort grep {/^[^.]/} $dot->read;
-print +(join("\0", @b) eq join("\0", @c)) ? "ok" : "not ok", " 4\n";
+cmp_ok(join("\0", @b), 'eq', join("\0", @c),
+    "After 'rewind', directory re-read as expected");
 
-$dot->close;
+ok($dot->close, "'close' method returns true value");
 $dot->rewind;
-print defined($dot->read) ? "not ok" : "ok", " 5\n";
+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 "..";
+}