Commit | Line | Data |
fb73857a |
1 | #!./perl |
2 | |
3 | # |
4 | # test glob() in File::DosGlob |
5 | # |
6 | |
7 | BEGIN { |
8 | chdir 't' if -d 't'; |
20822f61 |
9 | @INC = '../lib'; |
fb73857a |
10 | } |
11 | |
95d94a4f |
12 | print "1..10\n"; |
fb73857a |
13 | |
14 | # override it in main:: |
15 | use File::DosGlob 'glob'; |
16 | |
17 | # test if $_ takes as the default |
be708cc0 |
18 | my $expected; |
19 | if ($^O eq 'MacOS') { |
0bad50db |
20 | $expected = $_ = ":op:a*.t"; |
be708cc0 |
21 | } else { |
0bad50db |
22 | $expected = $_ = "op/a*.t"; |
be708cc0 |
23 | } |
fb73857a |
24 | my @r = glob; |
be708cc0 |
25 | print "not " if $_ ne $expected; |
fb73857a |
26 | print "ok 1\n"; |
b695f709 |
27 | print "# |@r|\nnot " if @r < 9; |
fb73857a |
28 | print "ok 2\n"; |
29 | |
30 | # check if <*/*> works |
be708cc0 |
31 | if ($^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 |
37 | print "# |@r|\nnot " if @r < 9; |
fb73857a |
38 | print "ok 3\n"; |
39 | my $r = scalar @r; |
40 | |
41 | # check if scalar context works |
42 | @r = (); |
be708cc0 |
43 | while (defined($_ = ($^O eq 'MacOS') ? <:*:a*.t> : <*/a*.t>)) { |
fb73857a |
44 | print "# $_\n"; |
45 | push @r, $_; |
46 | } |
47 | print "not " if @r != $r; |
48 | print "ok 4\n"; |
49 | |
91e74348 |
50 | # check if list context works |
fb73857a |
51 | @r = (); |
be708cc0 |
52 | if ($^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 |
62 | } |
63 | print "not " if @r != $r; |
64 | print "ok 5\n"; |
65 | |
66 | # test if implicit assign to $_ in while() works |
67 | @r = (); |
be708cc0 |
68 | if ($^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 |
78 | } |
79 | print "not " if @r != $r; |
80 | print "ok 6\n"; |
81 | |
82 | # test if explicit glob() gets assign magic too |
83 | my @s = (); |
be708cc0 |
84 | my $pat = ($^O eq 'MacOS') ? ':*:a*.t': '*/a*.t'; |
85 | while (glob ($pat)) { |
fb73857a |
86 | print "# $_\n"; |
87 | push @s, $_; |
88 | } |
89 | print "not " if "@r" ne "@s"; |
90 | print "ok 7\n"; |
91 | |
92 | # how about in a different package, like? |
93 | package Foo; |
94 | use File::DosGlob 'glob'; |
95 | @s = (); |
d5201bd2 |
96 | $pat = $^O eq 'MacOS' ? ':*:a*.t' : '*/a*.t'; |
97 | while (glob($pat)) { |
fb73857a |
98 | print "# $_\n"; |
99 | push @s, $_; |
100 | } |
101 | print "not " if "@r" ne "@s"; |
102 | print "ok 8\n"; |
103 | |
104 | # test if different glob ops maintain independent contexts |
105 | @s = (); |
d5201bd2 |
106 | if ($^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 |
128 | } |
129 | print "not " if "@r" ne "@s"; |
130 | print "ok 9\n"; |
131 | |
95d94a4f |
132 | # how about a global override, hm? |
133 | eval <<'EOT'; |
134 | use File::DosGlob 'GLOBAL_glob'; |
135 | package Bar; |
136 | @s = (); |
d5201bd2 |
137 | if ($^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 |
159 | } |
160 | print "not " if "@r" ne "@s"; |
161 | print "ok 10\n"; |
162 | EOT |