1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
|
#!./perl
BEGIN {
chdir 't' if -d 't';
@INC = '../lib';
require Config; Config->import;
if ($Config{'extensions'} !~ /\bFile\/Glob\b/i) {
print "1..0\n";
exit 0;
}
}
use Test::More tests => 11;
BEGIN {
*CORE::GLOBAL::glob = sub { "Just another Perl hacker," };
}
BEGIN {
if ("Just another Perl hacker," ne (<*>)[0]) {
die <<EOMessage;
Your version of perl ($]) doesn't seem to allow extensions to override
the core glob operator.
EOMessage
}
}
BEGIN {
use_ok('File::Glob', ':globally');
}
$_ = "op/*.t";
my @r = glob;
is($_, "op/*.t", 'pattern intact after use of core glob function');
cmp_ok(scalar @r, '>=', 3, 'check if core glob function works');
@r = <*/*.t>;
# at least t/global.t t/basic.t, t/taint.t
cmp_ok(scalar @r, '>=', 3, 'check if <*/*> works');
my $r = scalar @r;
@r = ();
while (defined($_ = <*/*.t>)) {
#print "# $_\n";
push @r, $_;
}
is(scalar @r, $r, 'check if scalar context works');
@r = ();
for (<*/*.t>) {
#print "# $_\n";
push @r, $_;
}
is(scalar @r, $r, 'check if list context works');
@r = ();
while (<*/*.t>) {
#print "# $_\n";
push @r, $_;
}
is(scalar @r, $r, 'implicit assign to $_ in while()');
my @s = ();
while (glob('*/*.t')) {
#print "# $_\n";
push @s, $_;
}
is("@r", "@s", 'explicit glob() gets assign magic too');
package Foo;
use File::Glob ':globally';
@s = ();
while (glob('*/*.t')) {
#print "# $_\n";
push @s, $_;
}
main::is("@r", "@s", 'in a different package');
# test if different glob ops maintain independent contexts
@s = ();
my $i = 0;
while (<*/*.t>) {
#print "# $_ <";
push @s, $_;
while (<bas*/*.t>) {
#print " $_";
$i++;
}
#print " >\n";
}
main::is("@r", "@s", 'different glob ops maintain independent contexts');
main::isnt($i, 0, 'different glob ops maintain independent contexts');
|
