}
use strict;
+use File::Temp qw( tempdir );
+use Cwd;
-my $DIR = $^O eq 'MacOS' ? ":" : ".";
+my $cwd = cwd();
-my $CLASS = "IO::Dir";
-my $dot = $CLASS->new($DIR);
-ok(defined($dot));
+{
+ my $DIR = tempdir( CLEANUP => 1 );
+ chdir $DIR or die "Unable to chdir to $DIR";
+ my @IO_files =
+ ( 'ChangeLog', 'IO.pm', 'IO.xs', 'Makefile.PL', 'poll.c', 'poll.h', 'README' );
+ my @IO_subdirs = ( qw| hints lib t | );
-my @a = sort <*>;
-my $first;
-do { $first = $dot->read } while defined($first) && $first =~ /^\./;
-ok(+(grep { $_ eq $first } @a));
+ for my $f (@IO_files) {
+ open my $OUT, '>', $f or die "Unable to open '$DIR/$f' for writing";
+ close $OUT or die "Unable to close '$DIR/$f' after writing";
+ }
+ for my $d (@IO_subdirs) { mkdir $d or die "Unable to mkdir '$DIR/$d'"; }
-my @b = sort($first, (grep {/^[^.]/} $dot->read));
-ok(+(join("\0", @a) eq join("\0", @b)));
+ my $CLASS = "IO::Dir";
+ my $dot = $CLASS->new($DIR);
+ ok(defined($dot), "Able to create IO::Dir object for $DIR");
-ok($dot->rewind,'rewind');
-my @c = sort grep {/^[^.]/} $dot->read;
-ok(+(join("\0", @b) eq join("\0", @c)));
+ my @a = sort <*>;
+ my $first;
+ do { $first = $dot->read } while defined($first) && $first =~ /^\./;
+ ok(+(grep { $_ eq $first } @a), "directory entry found");
-ok($dot->close,'close');
-{ local $^W; # avoid warnings on invalid dirhandle
-ok(!$dot->rewind, "rewind on closed");
-ok(!defined($dot->read));
-}
+ my @b = sort($first, (grep {/^[^.]/} $dot->read));
+ ok(+(join("\0", @a) eq join("\0", @b)), "two lists of directory entries match (Case 1)");
+
+ ok($dot->rewind,'rewind');
+ my @c = sort grep {/^[^.]/} $dot->read;
+ ok(+(join("\0", @b) eq join("\0", @c)), "two lists of directory entries match (Case 2)");
+
+ ok($dot->close,'close');
+ {
+ local $^W; # avoid warnings on invalid dirhandle
+ ok(!$dot->rewind, "rewind on closed");
+ ok(!defined($dot->read), "Directory handle closed; hence 'read' returns undef");
+ }
-open(FH,'>','X') || die "Can't create x";
-print FH "X";
-close(FH) or die "Can't close: $!";
+ open(FH,'>','X') || die "Can't create x";
+ print FH "X";
+ close(FH) or die "Can't close: $!";
-my %dir;
-tie %dir, $CLASS, $DIR;
-my @files = keys %dir;
+ my %dir;
+ tie %dir, $CLASS, $DIR;
+ my @files = keys %dir;
-# I hope we do not have an empty dir :-)
-ok(scalar @files);
+ # I hope we do not have an empty dir :-)
+ ok(scalar @files, "Tied hash interface finds directory entries");
-my $stat = $dir{'X'};
-isa_ok($stat,'File::stat');
-ok(defined($stat) && $stat->size == 1);
+ my $stat = $dir{'X'};
+ isa_ok($stat,'File::stat');
+ ok(defined($stat) && $stat->size == 1,
+ "Confirm that we wrote a file of size 1 byte");
-delete $dir{'X'};
+ delete $dir{'X'};
-ok(-f 'X');
+ ok(-f 'X', "Confirm that file still exists after entry in tied hash has been deleted");
-my %dirx;
-tie %dirx, $CLASS, $DIR, DIR_UNLINK;
+ my %dirx;
+ tie %dirx, $CLASS, $DIR, DIR_UNLINK;
-my $statx = $dirx{'X'};
-isa_ok($statx,'File::stat');
-ok(defined($statx) && $statx->size == 1);
+ my $statx = $dirx{'X'};
+ isa_ok($statx,'File::stat');
+ ok(defined($statx) && $statx->size == 1,
+ "Confirm that we still have the 1-byte file");
-delete $dirx{'X'};
+ delete $dirx{'X'};
+
+ my $description = "Tied hash interface with DIR_UNLINK:";
+ $description .= " deleting an element from hash deletes corresponding directory entry";
+ ok(!(-f 'X'), $description);
+
+ chdir $cwd or die "Unable to chdir back to $cwd";
+}
-ok(!(-f 'X'));