lib/DirHandle.t

   1 #!./perl
   2
   3 BEGIN {
   4     chdir 't' if -d 't';
   5     @INC = '../lib';
   6     require Config; import Config;
   7     if (not $Config{'d_readdir'}) {
   8         print "1..0\n";
   9         exit 0;
  10     }
  11 }
  12
  13 use DirHandle;
  14 use Test::More tests => 31;
  15
  16 # Fetching the list of files in two different ways and expecting them
  17 # to be the same is a race condition when tests are running in parallel.
  18 # So go somewhere quieter.
  19 my $chdir;
  20 if ($ENV{PERL_CORE} && -d 'uni') {
  21   chdir 'uni';
  22   push @INC, '../../lib';
  23   $chdir++;
  24 };
  25
  26 $dot = DirHandle->new('.');
  27
  28 ok(defined $dot, "DirHandle->new returns defined value");
  29 isa_ok($dot, 'DirHandle');
  30
  31 @a = sort <*>;
  32 do { $first = $dot->read } while defined($first) && $first =~ /^\./;
  33 ok(+(grep { $_ eq $first } @a),
  34     "Scalar context: First non-dot entry returned by 'read' is found in glob");
  35
  36 @b = sort($first, (grep {/^[^.]/} $dot->read));
  37 ok(+(join("\0", @a) eq join("\0", @b)),
  38     "List context: Remaining entries returned by 'read' match glob");
  39
  40 ok($dot->rewind, "'rewind' method returns true value");
  41 @c = sort grep {/^[^.]/} $dot->read;
  42 cmp_ok(join("\0", @b), 'eq', join("\0", @c),
  43     "After 'rewind', directory re-read as expected");
  44
  45 ok($dot->close, "'close' method returns true value");
  46 $dot->rewind;
  47 ok(! defined $dot->read,
  48     "Having closed the directory handle -- and notwithstanding invocation of 'rewind' -- 'read' returns undefined value");
  49
  50 {
  51     local $@;
  52     eval { $redot = DirHandle->new( '.', '..' ); };
  53     like($@, qr/^usage/,
  54         "DirHandle constructor with too many arguments fails as expected");
  55 }
  56
  57 # Now let's test with directory argument provided to 'open' rather than 'new'
  58
  59 $redot = DirHandle->new();
  60 ok(defined $redot, "DirHandle->new returns defined value even without provided argument");
  61 isa_ok($redot, 'DirHandle');
  62 ok($redot->open('.'), "Explicit call of 'open' method returns true value");
  63 do { $first = $redot->read } while defined($first) && $first =~ /^\./;
  64 ok(+(grep { $_ eq $first } @a),
  65     "Scalar context: First non-dot entry returned by 'read' is found in glob");
  66
  67 @b = sort($first, (grep {/^[^.]/} $redot->read));
  68 ok(+(join("\0", @a) eq join("\0", @b)),
  69     "List context: Remaining entries returned by 'read' match glob");
  70
  71 ok($redot->rewind, "'rewind' method returns true value");
  72 @c = sort grep {/^[^.]/} $redot->read;
  73 cmp_ok(join("\0", @b), 'eq', join("\0", @c),
  74     "After 'rewind', directory re-read as expected");
  75
  76 ok($redot->close, "'close' method returns true value");
  77 $redot->rewind;
  78 ok(! defined $redot->read,
  79     "Having closed the directory handle -- and notwithstanding invocation of 'rewind' -- 'read' returns undefined value");
  80
  81 $undot = DirHandle->new('foobar');
  82 ok(! defined $undot,
  83     "Constructor called with non-existent directory returns undefined value");
  84
  85 # Test error conditions for various methods
  86
  87 $aadot = DirHandle->new();
  88 ok(defined $aadot, "DirHandle->new returns defined value even without provided argument");
  89 isa_ok($aadot, 'DirHandle');
  90 {
  91     local $@;
  92     eval { $aadot->open('.', '..'); };
  93     like($@, qr/^usage/,
  94         "'open' called with too many arguments fails as expected");
  95 }
  96 ok($aadot->open('.'), "Explicit call of 'open' method returns true value");
  97 {
  98     local $@;
  99     eval { $aadot->read('foobar'); };
 100     like($@, qr/^usage/,
 101         "'read' called with argument fails as expected");
 102 }
 103 {
 104     local $@;
 105     eval { $aadot->close('foobar'); };
 106     like($@, qr/^usage/,
 107         "'close' called with argument fails as expected");
 108 }
 109 {
 110     local $@;
 111     eval { $aadot->rewind('foobar'); };
 112     like($@, qr/^usage/,
 113         "'rewind' called with argument fails as expected");
 114 }
 115
 116 {
 117     local $@;
 118     eval { $bbdot = DirHandle::new(); };
 119     like($@, qr/^usage/,
 120         "DirHandle called as function but with no arguments fails as expected");
 121 }
 122
 123 $bbdot = DirHandle->new();
 124 ok(! $bbdot->open('foobar'),
 125     "Calling open method on nonexistent directory returns false value");
 126 ok(! $bbdot->read(),
 127     "Calling read method after failed open method returns false value");
 128 ok(! $bbdot->rewind(),
 129     "Calling rewind method after failed open method returns false value");
 130 ok(! $bbdot->close(),
 131     "Calling close method after failed open method returns false value");
 132
 133 if ($chdir) {
 134   chdir "..";
 135 }