This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
* Fixed output for lex-like scanners example in perlop
[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
95d94a4f 12print "1..10\n";
fb73857a
PP
13
14# override it in main::
15use File::DosGlob 'glob';
16
17# test if $_ takes as the default
be708cc0
JH
18my $expected;
19if ($^O eq 'MacOS') {
0bad50db 20 $expected = $_ = ":op:a*.t";
be708cc0 21} else {
0bad50db 22 $expected = $_ = "op/a*.t";
be708cc0 23}
fb73857a 24my @r = glob;
be708cc0 25print "not " if $_ ne $expected;
fb73857a 26print "ok 1\n";
b695f709 27print "# |@r|\nnot " if @r < 9;
fb73857a
PP
28print "ok 2\n";
29
30# check if <*/*> works
be708cc0
JH
31if ($^O eq 'MacOS') {
32 @r = <:*:a*.t>;
33} else {
34 @r = <*/a*.t>;
35}
fb73857a 36# atleast {argv,abbrev,anydbm,autoloader,append,arith,array,assignwarn,auto}.t
be708cc0 37print "# |@r|\nnot " if @r < 9;
fb73857a
PP
38print "ok 3\n";
39my $r = scalar @r;
40
41# check if scalar context works
42@r = ();
be708cc0 43while (defined($_ = ($^O eq 'MacOS') ? <:*:a*.t> : <*/a*.t>)) {
fb73857a
PP
44 print "# $_\n";
45 push @r, $_;
46}
47print "not " if @r != $r;
48print "ok 4\n";
49
91e74348 50# check if list context works
fb73857a 51@r = ();
be708cc0
JH
52if ($^O eq 'MacOS') {
53 for (<:*:a*.t>) {
54 print "# $_\n";
55 push @r, $_;
56 }
57} else {
58 for (<*/a*.t>) {
59 print "# $_\n";
60 push @r, $_;
61 }
fb73857a
PP
62}
63print "not " if @r != $r;
64print "ok 5\n";
65
66# test if implicit assign to $_ in while() works
67@r = ();
be708cc0
JH
68if ($^O eq 'MacOS') {
69 while (<:*:a*.t>) {
70 print "# $_\n";
71 push @r, $_;
72 }
73} else {
74 while (<*/a*.t>) {
75 print "# $_\n";
76 push @r, $_;
77 }
fb73857a
PP
78}
79print "not " if @r != $r;
80print "ok 6\n";
81
82# test if explicit glob() gets assign magic too
83my @s = ();
be708cc0
JH
84my $pat = ($^O eq 'MacOS') ? ':*:a*.t': '*/a*.t';
85while (glob ($pat)) {
fb73857a
PP
86 print "# $_\n";
87 push @s, $_;
88}
89print "not " if "@r" ne "@s";
90print "ok 7\n";
91
92# how about in a different package, like?
93package Foo;
94use File::DosGlob 'glob';
95@s = ();
d5201bd2
JH
96$pat = $^O eq 'MacOS' ? ':*:a*.t' : '*/a*.t';
97while (glob($pat)) {
fb73857a
PP
98 print "# $_\n";
99 push @s, $_;
100}
101print "not " if "@r" ne "@s";
102print "ok 8\n";
103
104# test if different glob ops maintain independent contexts
105@s = ();
d5201bd2
JH
106if ($^O eq 'MacOS') {
107 while (<:*:a*.t>) {
108 my $i = 0;
109 print "# $_ <";
110 push @s, $_;
111 while (<:*:b*.t>) {
112 print " $_";
113 $i++;
114 }
115 print " >\n";
116 }
117} else {
118 while (<*/a*.t>) {
119 my $i = 0;
120 print "# $_ <";
121 push @s, $_;
122 while (<*/b*.t>) {
123 print " $_";
124 $i++;
125 }
126 print " >\n";
fb73857a 127 }
fb73857a
PP
128}
129print "not " if "@r" ne "@s";
130print "ok 9\n";
131
95d94a4f
GS
132# how about a global override, hm?
133eval <<'EOT';
134use File::DosGlob 'GLOBAL_glob';
135package Bar;
136@s = ();
d5201bd2
JH
137if ($^O eq 'MacOS') {
138 while (<:*:a*.t>) {
139 my $i = 0;
140 print "# $_ <";
141 push @s, $_;
142 while (glob ':*:b*.t') {
143 print " $_";
144 $i++;
145 }
146 print " >\n";
147 }
148} else {
149 while (<*/a*.t>) {
150 my $i = 0;
151 print "# $_ <";
152 push @s, $_;
153 while (glob '*/b*.t') {
154 print " $_";
155 $i++;
156 }
157 print " >\n";
95d94a4f 158 }
95d94a4f
GS
159}
160print "not " if "@r" ne "@s";
161print "ok 10\n";
162EOT