1#!./perl 2 3BEGIN { 4 require($ENV{PERL_CORE} ? "../../t/test.pl" : "./t/test.pl"); 5 plan(16); 6 7 use_ok('IO::Dir'); 8 IO::Dir->import(DIR_UNLINK); 9} 10 11use strict; 12use File::Temp qw( tempdir ); 13use Cwd; 14 15my $cwd = cwd(); 16 17{ 18 my $DIR = tempdir( CLEANUP => 1 ); 19 chdir $DIR or die "Unable to chdir to $DIR"; 20 my @IO_files = 21 ( 'ChangeLog', 'IO.pm', 'IO.xs', 'Makefile.PL', 'poll.c', 'poll.h', 'README' ); 22 my @IO_subdirs = ( qw| hints lib t | ); 23 24 for my $f (@IO_files) { 25 open my $OUT, '>', $f or die "Unable to open '$DIR/$f' for writing"; 26 close $OUT or die "Unable to close '$DIR/$f' after writing"; 27 } 28 for my $d (@IO_subdirs) { mkdir $d or die "Unable to mkdir '$DIR/$d'"; } 29 30 my $CLASS = "IO::Dir"; 31 my $dot = $CLASS->new($DIR); 32 ok(defined($dot), "Able to create IO::Dir object for $DIR"); 33 34 my @a = sort <*>; 35 my $first; 36 do { $first = $dot->read } while defined($first) && $first =~ /^\./; 37 ok(+(grep { $_ eq $first } @a), "directory entry found"); 38 39 my @b = sort($first, (grep {/^[^.]/} $dot->read)); 40 ok(+(join("\0", @a) eq join("\0", @b)), "two lists of directory entries match (Case 1)"); 41 42 ok($dot->rewind,'rewind'); 43 my @c = sort grep {/^[^.]/} $dot->read; 44 ok(+(join("\0", @b) eq join("\0", @c)), "two lists of directory entries match (Case 2)"); 45 46 ok($dot->close,'close'); 47 { 48 local $^W; # avoid warnings on invalid dirhandle 49 ok(!$dot->rewind, "rewind on closed"); 50 ok(!defined($dot->read), "Directory handle closed; 'read' returns undef"); 51 } 52 53 open(FH,'>','X') || die "Can't create x"; 54 print FH "X"; 55 close(FH) or die "Can't close: $!"; 56 57 my %dir; 58 tie %dir, $CLASS, $DIR; 59 my @files = keys %dir; 60 61 # I hope we do not have an empty dir :-) 62 ok(scalar @files, "Tied hash interface finds directory entries"); 63 64 my $stat = $dir{'X'}; 65 isa_ok($stat,'File::stat'); 66 ok(defined($stat) && $stat->size == 1, 67 "Confirm that we wrote a file of size 1 byte"); 68 69 delete $dir{'X'}; 70 71 ok(-f 'X', "File still exists after tied hash entry deleted"); 72 73 my %dirx; 74 tie %dirx, $CLASS, $DIR, DIR_UNLINK; 75 76 my $statx = $dirx{'X'}; 77 isa_ok($statx,'File::stat'); 78 ok(defined($statx) && $statx->size == 1, 79 "Confirm that we still have the 1-byte file"); 80 81 delete $dirx{'X'}; 82 83 ok(!(-f 'X'), "Using DIR_UNLINK deletes tied hash element and directory entry"); 84 85 chdir $cwd or die "Unable to chdir back to $cwd"; 86} 87 88