This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
[perl #113684] Make redo/last/next/dump accept expr
[perl5.git] / t / op / readdir.t
CommitLineData
988174c1
LW
1#!./perl
2
72b16652
GS
3BEGIN {
4 chdir 't' if -d 't';
20822f61 5 @INC = '../lib';
63dddcfa 6 require './test.pl';
72b16652
GS
7}
8
63dddcfa
NC
9use strict;
10use warnings;
11use vars qw($fh @fh %fh);
988174c1 12
63dddcfa
NC
13eval 'opendir(NOSUCH, "no/such/directory");';
14skip_all($@) if $@;
988174c1 15
63dddcfa 16for my $i (1..2000) {
1236053a
GS
17 local *OP;
18 opendir(OP, "op") or die "can't opendir: $!";
19 # should auto-closedir() here
20}
21
63dddcfa
NC
22is(opendir(OP, "op"), 1);
23my @D = grep(/^[^\.].*\.t$/i, readdir(OP));
988174c1
LW
24closedir(OP);
25
89eb5450 26my $expect;
63dddcfa
NC
27{
28 open my $man, '<', '../MANIFEST' or die "Can't open ../MANIFEST: $!";
29 while (<$man>) {
30 ++$expect if m!^t/op/[^/]+\t!;
31 }
89eb5450 32}
63dddcfa 33
89eb5450 34my ($min, $max) = ($expect - 10, $expect + 10);
63dddcfa 35within(scalar @D, $expect, 10, 'counting op/*.t');
988174c1 36
63dddcfa
NC
37my @R = sort @D;
38my @G = sort <op/*.t>;
a0d0e21e
LW
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}
7b903762 44while (@R && @G && $G[0] eq 'op/'.$R[0]) {
988174c1
LW
45 shift(@R);
46 shift(@G);
47}
63dddcfa
NC
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
735302bd
SF
60# See that perl does not segfault upon readdir($x=".");
61# http://rt.perl.org/rt3/Ticket/Display.html?id=68182
9baaa1e1
FC
62fresh_perl_like(<<'EOP', qr/^no crash/, {}, 'RT #68182');
63 eval {
64a8ad70 64 my $x = ".";
735302bd 65 my @files = readdir($x);
9baaa1e1
FC
66 };
67 print "no crash";
63dddcfa
NC
68EOP
69
70done_testing();