Commit | Line | Data |
72b16652 |
1 | #!./perl |
2 | |
3 | BEGIN { |
4 | chdir 't' if -d 't'; |
7369a524 |
5 | if ($^O eq 'MacOS') { |
6 | @INC = qw(: ::lib ::macos:lib); |
7 | } else { |
8 | @INC = '.'; |
9 | push @INC, '../lib'; |
10 | } |
d2a01882 |
11 | require Config; import Config; |
12 | if ($Config{'extensions'} !~ /\bFile\/Glob\b/i) { |
13 | print "1..0\n"; |
14 | exit 0; |
15 | } |
72b16652 |
16 | print "1..10\n"; |
17 | } |
18 | END { |
19 | print "not ok 1\n" unless $loaded; |
20 | } |
21 | |
22 | BEGIN { |
23 | *CORE::GLOBAL::glob = sub { "Just another Perl hacker," }; |
24 | } |
25 | |
26 | BEGIN { |
27 | if ("Just another Perl hacker," ne (<*>)[0]) { |
28 | die <<EOMessage; |
29 | Your version of perl ($]) doesn't seem to allow extensions to override |
30 | the core glob operator. |
31 | EOMessage |
32 | } |
33 | } |
34 | |
220398a0 |
35 | use File::Glob ':globally'; |
72b16652 |
36 | $loaded = 1; |
37 | print "ok 1\n"; |
38 | |
b695f709 |
39 | $_ = $^O eq "MacOS" ? ":op:*.t" : "op/*.t"; |
72b16652 |
40 | my @r = glob; |
b695f709 |
41 | print "not " if $_ ne ($^O eq "MacOS" ? ":op:*.t" : "op/*.t"); |
72b16652 |
42 | print "ok 2\n"; |
43 | |
72b16652 |
44 | print "# |@r|\nnot " if @r < 3; |
45 | print "ok 3\n"; |
46 | |
47 | # check if <*/*> works |
7369a524 |
48 | if ($^O eq "MacOS") { |
49 | @r = <:*:*.t>; |
50 | } else { |
51 | @r = <*/*.t>; |
52 | } |
72b16652 |
53 | # at least t/global.t t/basic.t, t/taint.t |
54 | print "not " if @r < 3; |
55 | print "ok 4\n"; |
56 | my $r = scalar @r; |
57 | |
58 | # check if scalar context works |
59 | @r = (); |
7369a524 |
60 | if ($^O eq "MacOS") { |
61 | while (defined($_ = <:*:*.t>)) { |
62 | #print "# $_\n"; |
63 | push @r, $_; |
64 | } |
65 | } else { |
66 | while (defined($_ = <*/*.t>)) { |
67 | #print "# $_\n"; |
68 | push @r, $_; |
69 | } |
72b16652 |
70 | } |
71 | print "not " if @r != $r; |
72 | print "ok 5\n"; |
73 | |
91e74348 |
74 | # check if list context works |
72b16652 |
75 | @r = (); |
7369a524 |
76 | if ($^O eq "MacOS") { |
77 | for (<:*:*.t>) { |
78 | #print "# $_\n"; |
79 | push @r, $_; |
80 | } |
81 | } else { |
82 | for (<*/*.t>) { |
83 | #print "# $_\n"; |
84 | push @r, $_; |
85 | } |
72b16652 |
86 | } |
87 | print "not " if @r != $r; |
88 | print "ok 6\n"; |
89 | |
90 | # test if implicit assign to $_ in while() works |
91 | @r = (); |
7369a524 |
92 | if ($^O eq "MacOS") { |
93 | while (<:*:*.t>) { |
94 | #print "# $_\n"; |
95 | push @r, $_; |
96 | } |
97 | } else { |
98 | while (<*/*.t>) { |
99 | #print "# $_\n"; |
100 | push @r, $_; |
101 | } |
72b16652 |
102 | } |
103 | print "not " if @r != $r; |
104 | print "ok 7\n"; |
105 | |
106 | # test if explicit glob() gets assign magic too |
107 | my @s = (); |
7369a524 |
108 | while (glob($^O eq 'MacOS' ? ':*:*.t' : '*/*.t')) { |
72b16652 |
109 | #print "# $_\n"; |
110 | push @s, $_; |
111 | } |
112 | print "not " if "@r" ne "@s"; |
113 | print "ok 8\n"; |
114 | |
115 | # how about in a different package, like? |
116 | package Foo; |
220398a0 |
117 | use File::Glob ':globally'; |
72b16652 |
118 | @s = (); |
7369a524 |
119 | while (glob($^O eq 'MacOS' ? ':*:*.t' : '*/*.t')) { |
72b16652 |
120 | #print "# $_\n"; |
121 | push @s, $_; |
122 | } |
123 | print "not " if "@r" ne "@s"; |
124 | print "ok 9\n"; |
125 | |
126 | # test if different glob ops maintain independent contexts |
127 | @s = (); |
128 | my $i = 0; |
7369a524 |
129 | if ($^O eq "MacOS") { |
130 | while (<:*:*.t>) { |
131 | #print "# $_ <"; |
132 | push @s, $_; |
133 | while (<:bas*:*.t>) { |
134 | #print " $_"; |
135 | $i++; |
136 | } |
137 | #print " >\n"; |
138 | } |
139 | } else { |
140 | while (<*/*.t>) { |
141 | #print "# $_ <"; |
142 | push @s, $_; |
143 | while (<bas*/*.t>) { |
144 | #print " $_"; |
145 | $i++; |
146 | } |
147 | #print " >\n"; |
72b16652 |
148 | } |
72b16652 |
149 | } |
150 | print "not " if "@r" ne "@s" or not $i; |
151 | print "ok 10\n"; |