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