This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Skip the right number of tests in DosGlob.t.
[perl5.git] / lib / File / DosGlob.t
CommitLineData
fb73857a
PP
1#!./perl
2
3#
4# test glob() in File::DosGlob
5#
6
7BEGIN {
8 chdir 't' if -d 't';
20822f61 9 @INC = '../lib';
fb73857a
PP
10}
11
dd2d1456 12use Test::More tests => 20;
fb73857a
PP
13
14# override it in main::
15use File::DosGlob 'glob';
16
2f3c8ce9
AD
17require Cwd;
18
be708cc0 19my $expected;
7d38af62 20$expected = $_ = "op/a*.t";
fb73857a 21my @r = glob;
dd2d1456
NC
22is ($_, $expected, 'test if $_ takes as the default');
23cmp_ok(@r, '>=', 9) or diag("|@r|");
fb73857a 24
7d38af62 25@r = <*/a*.t>;
fb73857a 26# atleast {argv,abbrev,anydbm,autoloader,append,arith,array,assignwarn,auto}.t
dd2d1456 27cmp_ok(@r, '>=', 9, 'check <*/*>') or diag("|@r|");
fb73857a
PP
28my $r = scalar @r;
29
fb73857a 30@r = ();
7d38af62 31while (defined($_ = <*/a*.t>)) {
fb73857a
PP
32 print "# $_\n";
33 push @r, $_;
34}
dd2d1456 35is(scalar @r, $r, 'check scalar context');
fb73857a 36
fb73857a 37@r = ();
7d38af62
NC
38for (<*/a*.t>) {
39 print "# $_\n";
40 push @r, $_;
fb73857a 41}
dd2d1456 42is(scalar @r, $r, 'check list context');
fb73857a 43
fb73857a 44@r = ();
7d38af62
NC
45while (<*/a*.t>) {
46 print "# $_\n";
47 push @r, $_;
fb73857a 48}
dd2d1456 49is(scalar @r, $r, 'implicit assign to $_ in while()');
fb73857a 50
fb73857a 51my @s = ();
7d38af62 52my $pat = '*/a*.t';
be708cc0 53while (glob ($pat)) {
fb73857a
PP
54 print "# $_\n";
55 push @s, $_;
56}
dd2d1456 57is("@r", "@s", 'explicit glob() gets assign magic too');
fb73857a 58
fb73857a
PP
59package Foo;
60use File::DosGlob 'glob';
dd2d1456 61use Test::More;
fb73857a 62@s = ();
7d38af62 63$pat = '*/a*.t';
d5201bd2 64while (glob($pat)) {
fb73857a
PP
65 print "# $_\n";
66 push @s, $_;
67}
dd2d1456 68is("@r", "@s", 'in a different package');
fb73857a 69
fb73857a 70@s = ();
7d38af62
NC
71while (<*/a*.t>) {
72 my $i = 0;
73 print "# $_ <";
74 push @s, $_;
75 while (<*/b*.t>) {
76 print " $_";
77 $i++;
fb73857a 78 }
7d38af62 79 print " >\n";
fb73857a 80}
dd2d1456 81is("@r", "@s", 'different glob ops maintain independent contexts');
fb73857a 82
dd2d1456 83@s = ();
95d94a4f
GS
84eval <<'EOT';
85use File::DosGlob 'GLOBAL_glob';
86package Bar;
7d38af62
NC
87while (<*/a*.t>) {
88 my $i = 0;
89 print "# $_ <";
90 push @s, $_;
91 while (glob '*/b*.t') {
92 print " $_";
93 $i++;
95d94a4f 94 }
7d38af62 95 print " >\n";
95d94a4f 96}
95d94a4f 97EOT
dd2d1456 98is("@r", "@s", 'global override');
2f3c8ce9
AD
99
100# Test that a glob pattern containing ()'s works.
83f61a2e 101# NB. The spaces in the glob patterns need to be backslash escaped.
2f3c8ce9 102my $filename_containing_parens = "foo (123) bar";
dd2d1456 103SKIP: {
723bc154 104 skip("can't create '$filename_containing_parens': $!", 9)
dd2d1456
NC
105 unless open my $touch, ">", $filename_containing_parens;
106 close $touch;
107
108 foreach my $pattern ("foo\\ (*", "*)\\ bar", "foo\\ (1*3)\\ bar") {
109 @r = ();
110 eval { @r = File::DosGlob::glob($pattern) };
111 is($@, "", "eval for glob($pattern)");
112 is(scalar @r, 1);
113 is($r[0], $filename_containing_parens);
114 }
2f3c8ce9 115
83f61a2e
CB
116 1 while unlink $filename_containing_parens;
117}
2f3c8ce9
AD
118
119# Test the globbing of a drive relative pattern such as "c:*.pl".
120# NB. previous versions of DosGlob inserted "./ after the drive letter to
121# make the expansion process work correctly. However, while it is harmless,
122# there is no reason for it to be in the result.
123my $cwd = Cwd::cwd();
124if ($cwd =~ /^([a-zA-Z]:)/) {
125 my $drive = $1;
126 @r = ();
127 # This assumes we're in the "t" directory.
128 eval { @r = File::DosGlob::glob("${drive}io/*.t") };
dd2d1456 129 ok(@r and !grep !m|^${drive}io/[^/]*\.t$|, @r);
2f3c8ce9 130} else {
dd2d1456 131 pass();
2f3c8ce9 132}