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 JH |
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 JH |
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 JH |
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 JH |
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 JH |
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 JH |
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 JH |
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 GS |
132 | # how about a global override, hm? |
133 | eval <<'EOT'; | |
134 | use File::DosGlob 'GLOBAL_glob'; | |
135 | package Bar; | |
136 | @s = (); | |
d5201bd2 JH |
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 GS |
159 | } |
160 | print "not " if "@r" ne "@s"; | |
161 | print "ok 10\n"; | |
162 | EOT |