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
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
|
#!./perl
#
# test glob() in File::DosGlob
#
BEGIN {
chdir 't' if -d 't';
@INC = '../lib';
}
use Test::More tests => 20;
# override it in main::
use File::DosGlob 'glob';
require Cwd;
my $expected;
$expected = $_ = "op/a*.t";
my @r = glob;
is ($_, $expected, 'test if $_ takes as the default');
cmp_ok(@r, '>=', 9) or diag("|@r|");
@r = <*/a*.t>;
# atleast {argv,abbrev,anydbm,autoloader,append,arith,array,assignwarn,auto}.t
cmp_ok(@r, '>=', 9, 'check <*/*>') or diag("|@r|");
my $r = scalar @r;
@r = ();
while (defined($_ = <*/a*.t>)) {
print "# $_\n";
push @r, $_;
}
is(scalar @r, $r, 'check scalar context');
@r = ();
for (<*/a*.t>) {
print "# $_\n";
push @r, $_;
}
is(scalar @r, $r, 'check list context');
@r = ();
while (<*/a*.t>) {
print "# $_\n";
push @r, $_;
}
is(scalar @r, $r, 'implicit assign to $_ in while()');
my @s = ();
my $pat = '*/a*.t';
while (glob ($pat)) {
print "# $_\n";
push @s, $_;
}
is("@r", "@s", 'explicit glob() gets assign magic too');
package Foo;
use File::DosGlob 'glob';
use Test::More;
@s = ();
$pat = '*/a*.t';
while (glob($pat)) {
print "# $_\n";
push @s, $_;
}
is("@r", "@s", 'in a different package');
@s = ();
while (<*/a*.t>) {
my $i = 0;
print "# $_ <";
push @s, $_;
while (<*/b*.t>) {
print " $_";
$i++;
}
print " >\n";
}
is("@r", "@s", 'different glob ops maintain independent contexts');
@s = ();
eval <<'EOT';
use File::DosGlob 'GLOBAL_glob';
package Bar;
while (<*/a*.t>) {
my $i = 0;
print "# $_ <";
push @s, $_;
while (glob '*/b*.t') {
print " $_";
$i++;
}
print " >\n";
}
EOT
is("@r", "@s", 'global override');
# Test that a glob pattern containing ()'s works.
# NB. The spaces in the glob patterns need to be backslash escaped.
my $filename_containing_parens = "foo (123) bar";
SKIP: {
skip("can't create '$filename_containing_parens': $!", 9)
unless open my $touch, ">", $filename_containing_parens;
close $touch;
foreach my $pattern ("foo\\ (*", "*)\\ bar", "foo\\ (1*3)\\ bar") {
@r = ();
eval { @r = File::DosGlob::glob($pattern) };
is($@, "", "eval for glob($pattern)");
is(scalar @r, 1);
is($r[0], $filename_containing_parens);
}
1 while unlink $filename_containing_parens;
}
# Test the globbing of a drive relative pattern such as "c:*.pl".
# NB. previous versions of DosGlob inserted "./ after the drive letter to
# make the expansion process work correctly. However, while it is harmless,
# there is no reason for it to be in the result.
my $cwd = Cwd::cwd();
if ($cwd =~ /^([a-zA-Z]:)/) {
my $drive = $1;
@r = ();
# This assumes we're in the "t" directory.
eval { @r = File::DosGlob::glob("${drive}io/*.t") };
ok(@r and !grep !m|^${drive}io/[^/]*\.t$|, @r);
} else {
pass();
}
|
