This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Remove MacOS Classic code from File::Find's tests.
[perl5.git] / lib / File / DosGlob.t
CommitLineData
fb73857a
PP
1#!./perl
2
3#
4# test glob() in File::DosGlob
5#
6
7BEGIN {
8 chdir 't' if -d 't';
20822f61 9 @INC = '../lib';
fb73857a
PP
10}
11
2f3c8ce9 12print "1..17\n";
fb73857a
PP
13
14# override it in main::
15use File::DosGlob 'glob';
16
2f3c8ce9
AD
17require Cwd;
18
fb73857a 19# test if $_ takes as the default
be708cc0
JH
20my $expected;
21if ($^O eq 'MacOS') {
0bad50db 22 $expected = $_ = ":op:a*.t";
be708cc0 23} else {
0bad50db 24 $expected = $_ = "op/a*.t";
be708cc0 25}
fb73857a 26my @r = glob;
be708cc0 27print "not " if $_ ne $expected;
fb73857a 28print "ok 1\n";
b695f709 29print "# |@r|\nnot " if @r < 9;
fb73857a
PP
30print "ok 2\n";
31
32# check if <*/*> works
be708cc0
JH
33if ($^O eq 'MacOS') {
34 @r = <:*:a*.t>;
35} else {
36 @r = <*/a*.t>;
37}
fb73857a 38# atleast {argv,abbrev,anydbm,autoloader,append,arith,array,assignwarn,auto}.t
be708cc0 39print "# |@r|\nnot " if @r < 9;
fb73857a
PP
40print "ok 3\n";
41my $r = scalar @r;
42
43# check if scalar context works
44@r = ();
be708cc0 45while (defined($_ = ($^O eq 'MacOS') ? <:*:a*.t> : <*/a*.t>)) {
fb73857a
PP
46 print "# $_\n";
47 push @r, $_;
48}
49print "not " if @r != $r;
50print "ok 4\n";
51
91e74348 52# check if list context works
fb73857a 53@r = ();
be708cc0
JH
54if ($^O eq 'MacOS') {
55 for (<:*:a*.t>) {
56 print "# $_\n";
57 push @r, $_;
58 }
59} else {
60 for (<*/a*.t>) {
61 print "# $_\n";
62 push @r, $_;
63 }
fb73857a
PP
64}
65print "not " if @r != $r;
66print "ok 5\n";
67
68# test if implicit assign to $_ in while() works
69@r = ();
be708cc0
JH
70if ($^O eq 'MacOS') {
71 while (<:*:a*.t>) {
72 print "# $_\n";
73 push @r, $_;
74 }
75} else {
76 while (<*/a*.t>) {
77 print "# $_\n";
78 push @r, $_;
79 }
fb73857a
PP
80}
81print "not " if @r != $r;
82print "ok 6\n";
83
84# test if explicit glob() gets assign magic too
85my @s = ();
be708cc0
JH
86my $pat = ($^O eq 'MacOS') ? ':*:a*.t': '*/a*.t';
87while (glob ($pat)) {
fb73857a
PP
88 print "# $_\n";
89 push @s, $_;
90}
91print "not " if "@r" ne "@s";
92print "ok 7\n";
93
94# how about in a different package, like?
95package Foo;
96use File::DosGlob 'glob';
97@s = ();
d5201bd2
JH
98$pat = $^O eq 'MacOS' ? ':*:a*.t' : '*/a*.t';
99while (glob($pat)) {
fb73857a
PP
100 print "# $_\n";
101 push @s, $_;
102}
103print "not " if "@r" ne "@s";
104print "ok 8\n";
105
106# test if different glob ops maintain independent contexts
107@s = ();
d5201bd2
JH
108if ($^O eq 'MacOS') {
109 while (<:*:a*.t>) {
110 my $i = 0;
111 print "# $_ <";
112 push @s, $_;
113 while (<:*:b*.t>) {
114 print " $_";
115 $i++;
116 }
117 print " >\n";
118 }
119} else {
120 while (<*/a*.t>) {
121 my $i = 0;
122 print "# $_ <";
123 push @s, $_;
124 while (<*/b*.t>) {
125 print " $_";
126 $i++;
127 }
128 print " >\n";
fb73857a 129 }
fb73857a
PP
130}
131print "not " if "@r" ne "@s";
132print "ok 9\n";
133
95d94a4f
GS
134# how about a global override, hm?
135eval <<'EOT';
136use File::DosGlob 'GLOBAL_glob';
137package Bar;
138@s = ();
d5201bd2
JH
139if ($^O eq 'MacOS') {
140 while (<:*:a*.t>) {
141 my $i = 0;
142 print "# $_ <";
143 push @s, $_;
144 while (glob ':*:b*.t') {
145 print " $_";
146 $i++;
147 }
148 print " >\n";
149 }
150} else {
151 while (<*/a*.t>) {
152 my $i = 0;
153 print "# $_ <";
154 push @s, $_;
155 while (glob '*/b*.t') {
156 print " $_";
157 $i++;
158 }
159 print " >\n";
95d94a4f 160 }
95d94a4f
GS
161}
162print "not " if "@r" ne "@s";
163print "ok 10\n";
164EOT
2f3c8ce9
AD
165
166# Test that a glob pattern containing ()'s works.
83f61a2e 167# NB. The spaces in the glob patterns need to be backslash escaped.
2f3c8ce9 168my $filename_containing_parens = "foo (123) bar";
83f61a2e
CB
169if (open(TOUCH, ">", $filename_containing_parens)) {
170 close(TOUCH);
2f3c8ce9 171
83f61a2e
CB
172 @r = ();
173 eval { @r = File::DosGlob::glob("foo\\ (*") };
174 print +($@ ? "not " : ""), "ok 11\n";
175 print "not " unless (@r == 1 and $r[0] eq $filename_containing_parens);
176 print "ok 12\n";
2f3c8ce9 177
83f61a2e
CB
178 @r = ();
179 eval { @r = File::DosGlob::glob("*)\\ bar") };
180 print +($@ ? "not " : ""), "ok 13\n";
181 print "not " unless (@r == 1 and $r[0] eq $filename_containing_parens);
182 print "ok 14\n";
2f3c8ce9 183
83f61a2e
CB
184 @r = ();
185 eval { @r = File::DosGlob::glob("foo\\ (1*3)\\ bar") };
186 print +($@ ? "not " : ""), "ok 15\n";
187 print "not " unless (@r == 1 and $r[0] eq $filename_containing_parens);
188 print "ok 16\n";
2f3c8ce9 189
83f61a2e
CB
190 1 while unlink $filename_containing_parens;
191}
192else {
193 for (11..16) {
194 print "ok $_ # skip - can't create '$filename_containing_parens': $!\n";
195 }
196}
2f3c8ce9
AD
197
198# Test the globbing of a drive relative pattern such as "c:*.pl".
199# NB. previous versions of DosGlob inserted "./ after the drive letter to
200# make the expansion process work correctly. However, while it is harmless,
201# there is no reason for it to be in the result.
202my $cwd = Cwd::cwd();
203if ($cwd =~ /^([a-zA-Z]:)/) {
204 my $drive = $1;
205 @r = ();
206 # This assumes we're in the "t" directory.
207 eval { @r = File::DosGlob::glob("${drive}io/*.t") };
208 print +((@r and !grep !m|^${drive}io/[^/]*\.t$|, @r) ? "" : "not "), "ok 17\n";
209} else {
210 print "ok 17\n";
211}