1#!./perl 2 3BEGIN { 4 chdir 't' if -d 't'; 5 require './test.pl'; 6 set_up_inc('../lib'); 7} 8 9use strict; 10use warnings; 11our ($fh, @fh, %fh); 12 13eval 'opendir(NOSUCH, "no/such/directory");'; 14skip_all($@) if $@; 15 16for my $i (1..2000) { 17 local *OP; 18 opendir(OP, "op") or die "can't opendir: $!"; 19 # should auto-closedir() here 20} 21 22is(opendir(OP, "op"), 1); 23my @D = grep(/^[^\.].*\.t$/i, readdir(OP)); 24closedir(OP); 25 26my $expect; 27{ 28 open my $man, '<', '../MANIFEST' or die "Can't open ../MANIFEST: $!"; 29 while (<$man>) { 30 ++$expect if m!^t/op/[^/]+\t!; 31 } 32} 33 34my ($min, $max) = ($expect - 10, $expect + 10); 35within(scalar @D, $expect, 10, 'counting op/*.t'); 36 37my @R = sort @D; 38my @G = sort <op/*.t>; 39if ($G[0] =~ m#.*\](\w+\.t)#i) { 40 # grep is to convert filespecs returned from glob under VMS to format 41 # identical to that returned by readdir 42 @G = grep(s#.*\](\w+\.t).*#op/$1#i,<op/*.t>); 43} 44while (@R && @G && $G[0] eq 'op/'.$R[0]) { 45 shift(@R); 46 shift(@G); 47} 48is(scalar @R, 0, 'readdir results all accounted for'); 49is(scalar @G, 0, 'glob results all accounted for'); 50 51is(opendir($fh, "op"), 1); 52is(ref $fh, 'GLOB'); 53is(opendir($fh[0], "op"), 1); 54is(ref $fh[0], 'GLOB'); 55is(opendir($fh{abc}, "op"), 1); 56is(ref $fh{abc}, 'GLOB'); 57isnt("$fh", "$fh[0]"); 58isnt("$fh", "$fh{abc}"); 59 60# See that perl does not segfault upon readdir($x="."); 61# http://rt.perl.org/rt3/Ticket/Display.html?id=68182 62fresh_perl_like(<<'EOP', qr/^no crash/, {}, 'RT #68182'); 63 eval { 64 my $x = "."; 65 my @files = readdir($x); 66 }; 67 print "no crash"; 68EOP 69 70SKIP: 71{ # [perl #118651] 72 # test that readdir doesn't modify errno on successfully reaching the end of the list 73 # in scalar context, POSIX requires that readdir() not modify errno on end-of-directory 74 75 my @s; 76 ok(opendir(OP, "op"), "opendir op"); 77 $! = 0; 78 while (defined(my $f = readdir OP)) { 79 push @s, $f 80 if $f =~ /^[^\.].*\.t$/i; 81 } 82 my $errno = $! + 0; 83 closedir OP; 84 is(@s, @D, "should be the same number of files, scalar or list") 85 or skip "mismatch on file count - presumably a readdir error", 1; 86 is($errno, 0, "errno preserved"); 87} 88 89done_testing(); 90