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 | } |
b695f709 |
24 | $_ = "op/a*.t"; |
fb73857a |
25 | my @r = glob; |
be708cc0 |
26 | print "not " if $_ ne $expected; |
fb73857a |
27 | print "ok 1\n"; |
b695f709 |
28 | print "# |@r|\nnot " if @r < 9; |
fb73857a |
29 | print "ok 2\n"; |
30 | |
31 | # check if <*/*> works |
be708cc0 |
32 | if ($^O eq 'MacOS') { |
33 | @r = <:*:a*.t>; |
34 | } else { |
35 | @r = <*/a*.t>; |
36 | } |
fb73857a |
37 | # atleast {argv,abbrev,anydbm,autoloader,append,arith,array,assignwarn,auto}.t |
be708cc0 |
38 | print "# |@r|\nnot " if @r < 9; |
fb73857a |
39 | print "ok 3\n"; |
40 | my $r = scalar @r; |
41 | |
42 | # check if scalar context works |
43 | @r = (); |
be708cc0 |
44 | while (defined($_ = ($^O eq 'MacOS') ? <:*:a*.t> : <*/a*.t>)) { |
fb73857a |
45 | print "# $_\n"; |
46 | push @r, $_; |
47 | } |
48 | print "not " if @r != $r; |
49 | print "ok 4\n"; |
50 | |
91e74348 |
51 | # check if list context works |
fb73857a |
52 | @r = (); |
be708cc0 |
53 | if ($^O eq 'MacOS') { |
54 | for (<:*:a*.t>) { |
55 | print "# $_\n"; |
56 | push @r, $_; |
57 | } |
58 | } else { |
59 | for (<*/a*.t>) { |
60 | print "# $_\n"; |
61 | push @r, $_; |
62 | } |
fb73857a |
63 | } |
64 | print "not " if @r != $r; |
65 | print "ok 5\n"; |
66 | |
67 | # test if implicit assign to $_ in while() works |
68 | @r = (); |
be708cc0 |
69 | if ($^O eq 'MacOS') { |
70 | while (<:*:a*.t>) { |
71 | print "# $_\n"; |
72 | push @r, $_; |
73 | } |
74 | } else { |
75 | while (<*/a*.t>) { |
76 | print "# $_\n"; |
77 | push @r, $_; |
78 | } |
fb73857a |
79 | } |
80 | print "not " if @r != $r; |
81 | print "ok 6\n"; |
82 | |
83 | # test if explicit glob() gets assign magic too |
84 | my @s = (); |
be708cc0 |
85 | my $pat = ($^O eq 'MacOS') ? ':*:a*.t': '*/a*.t'; |
86 | while (glob ($pat)) { |
fb73857a |
87 | print "# $_\n"; |
88 | push @s, $_; |
89 | } |
90 | print "not " if "@r" ne "@s"; |
91 | print "ok 7\n"; |
92 | |
93 | # how about in a different package, like? |
94 | package Foo; |
95 | use File::DosGlob 'glob'; |
96 | @s = (); |
97 | while (glob '*/a*.t') { |
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 = (); |
106 | while (<*/a*.t>) { |
107 | my $i = 0; |
108 | print "# $_ <"; |
109 | push @s, $_; |
110 | while (<*/b*.t>) { |
111 | print " $_"; |
112 | $i++; |
113 | } |
114 | print " >\n"; |
115 | } |
116 | print "not " if "@r" ne "@s"; |
117 | print "ok 9\n"; |
118 | |
95d94a4f |
119 | # how about a global override, hm? |
120 | eval <<'EOT'; |
121 | use File::DosGlob 'GLOBAL_glob'; |
122 | package Bar; |
123 | @s = (); |
124 | while (<*/a*.t>) { |
125 | my $i = 0; |
126 | print "# $_ <"; |
127 | push @s, $_; |
128 | while (glob '*/b*.t') { |
129 | print " $_"; |
130 | $i++; |
131 | } |
132 | print " >\n"; |
133 | } |
134 | print "not " if "@r" ne "@s"; |
135 | print "ok 10\n"; |
136 | EOT |