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 | |
7369a524 |
39 | $_ = $^O eq "MacOS" ? ":lib:*.t" : "lib/*.t"; |
72b16652 |
40 | my @r = glob; |
7369a524 |
41 | print "not " if $_ ne ($^O eq "MacOS" ? ":lib:*.t" : "lib/*.t"); |
72b16652 |
42 | print "ok 2\n"; |
43 | |
44 | # we should have at least basic.t, global.t, taint.t |
45 | print "# |@r|\nnot " if @r < 3; |
46 | print "ok 3\n"; |
47 | |
48 | # check if <*/*> works |
7369a524 |
49 | if ($^O eq "MacOS") { |
50 | @r = <:*:*.t>; |
51 | } else { |
52 | @r = <*/*.t>; |
53 | } |
72b16652 |
54 | # at least t/global.t t/basic.t, t/taint.t |
55 | print "not " if @r < 3; |
56 | print "ok 4\n"; |
57 | my $r = scalar @r; |
58 | |
59 | # check if scalar context works |
60 | @r = (); |
7369a524 |
61 | if ($^O eq "MacOS") { |
62 | while (defined($_ = <:*:*.t>)) { |
63 | #print "# $_\n"; |
64 | push @r, $_; |
65 | } |
66 | } else { |
67 | while (defined($_ = <*/*.t>)) { |
68 | #print "# $_\n"; |
69 | push @r, $_; |
70 | } |
72b16652 |
71 | } |
72 | print "not " if @r != $r; |
73 | print "ok 5\n"; |
74 | |
91e74348 |
75 | # check if list context works |
72b16652 |
76 | @r = (); |
7369a524 |
77 | if ($^O eq "MacOS") { |
78 | for (<:*:*.t>) { |
79 | #print "# $_\n"; |
80 | push @r, $_; |
81 | } |
82 | } else { |
83 | for (<*/*.t>) { |
84 | #print "# $_\n"; |
85 | push @r, $_; |
86 | } |
72b16652 |
87 | } |
88 | print "not " if @r != $r; |
89 | print "ok 6\n"; |
90 | |
91 | # test if implicit assign to $_ in while() works |
92 | @r = (); |
7369a524 |
93 | if ($^O eq "MacOS") { |
94 | while (<:*:*.t>) { |
95 | #print "# $_\n"; |
96 | push @r, $_; |
97 | } |
98 | } else { |
99 | while (<*/*.t>) { |
100 | #print "# $_\n"; |
101 | push @r, $_; |
102 | } |
72b16652 |
103 | } |
104 | print "not " if @r != $r; |
105 | print "ok 7\n"; |
106 | |
107 | # test if explicit glob() gets assign magic too |
108 | my @s = (); |
7369a524 |
109 | while (glob($^O eq 'MacOS' ? ':*:*.t' : '*/*.t')) { |
72b16652 |
110 | #print "# $_\n"; |
111 | push @s, $_; |
112 | } |
113 | print "not " if "@r" ne "@s"; |
114 | print "ok 8\n"; |
115 | |
116 | # how about in a different package, like? |
117 | package Foo; |
220398a0 |
118 | use File::Glob ':globally'; |
72b16652 |
119 | @s = (); |
7369a524 |
120 | while (glob($^O eq 'MacOS' ? ':*:*.t' : '*/*.t')) { |
72b16652 |
121 | #print "# $_\n"; |
122 | push @s, $_; |
123 | } |
124 | print "not " if "@r" ne "@s"; |
125 | print "ok 9\n"; |
126 | |
127 | # test if different glob ops maintain independent contexts |
128 | @s = (); |
129 | my $i = 0; |
7369a524 |
130 | if ($^O eq "MacOS") { |
131 | while (<:*:*.t>) { |
132 | #print "# $_ <"; |
133 | push @s, $_; |
134 | while (<:bas*:*.t>) { |
135 | #print " $_"; |
136 | $i++; |
137 | } |
138 | #print " >\n"; |
139 | } |
140 | } else { |
141 | while (<*/*.t>) { |
142 | #print "# $_ <"; |
143 | push @s, $_; |
144 | while (<bas*/*.t>) { |
145 | #print " $_"; |
146 | $i++; |
147 | } |
148 | #print " >\n"; |
72b16652 |
149 | } |
72b16652 |
150 | } |
151 | print "not " if "@r" ne "@s" or not $i; |
152 | print "ok 10\n"; |