This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Integrate mainline
[perl5.git] / t / lib / dosglob.t
CommitLineData
fb73857a 1#!./perl
2
3#
4# test glob() in File::DosGlob
5#
6
7BEGIN {
8 chdir 't' if -d 't';
20822f61 9 @INC = '../lib';
fb73857a 10}
11
95d94a4f 12print "1..10\n";
fb73857a 13
14# override it in main::
15use File::DosGlob 'glob';
16
17# test if $_ takes as the default
18$_ = "lib/a*.t";
19my @r = glob;
20print "not " if $_ ne 'lib/a*.t';
21print "ok 1\n";
22# we should have at least abbrev.t, anydbm.t, autoloader.t
23print "# |@r|\nnot " if @r < 3;
24print "ok 2\n";
25
26# check if <*/*> works
27@r = <*/a*.t>;
28# atleast {argv,abbrev,anydbm,autoloader,append,arith,array,assignwarn,auto}.t
29print "not " if @r < 9;
30print "ok 3\n";
31my $r = scalar @r;
32
33# check if scalar context works
34@r = ();
35while (defined($_ = <*/a*.t>)) {
36 print "# $_\n";
37 push @r, $_;
38}
39print "not " if @r != $r;
40print "ok 4\n";
41
91e74348 42# check if list context works
fb73857a 43@r = ();
44for (<*/a*.t>) {
45 print "# $_\n";
46 push @r, $_;
47}
48print "not " if @r != $r;
49print "ok 5\n";
50
51# test if implicit assign to $_ in while() works
52@r = ();
53while (<*/a*.t>) {
54 print "# $_\n";
55 push @r, $_;
56}
57print "not " if @r != $r;
58print "ok 6\n";
59
60# test if explicit glob() gets assign magic too
61my @s = ();
62while (glob '*/a*.t') {
63 print "# $_\n";
64 push @s, $_;
65}
66print "not " if "@r" ne "@s";
67print "ok 7\n";
68
69# how about in a different package, like?
70package Foo;
71use File::DosGlob 'glob';
72@s = ();
73while (glob '*/a*.t') {
74 print "# $_\n";
75 push @s, $_;
76}
77print "not " if "@r" ne "@s";
78print "ok 8\n";
79
80# test if different glob ops maintain independent contexts
81@s = ();
82while (<*/a*.t>) {
83 my $i = 0;
84 print "# $_ <";
85 push @s, $_;
86 while (<*/b*.t>) {
87 print " $_";
88 $i++;
89 }
90 print " >\n";
91}
92print "not " if "@r" ne "@s";
93print "ok 9\n";
94
95d94a4f
GS
95# how about a global override, hm?
96eval <<'EOT';
97use File::DosGlob 'GLOBAL_glob';
98package Bar;
99@s = ();
100while (<*/a*.t>) {
101 my $i = 0;
102 print "# $_ <";
103 push @s, $_;
104 while (glob '*/b*.t') {
105 print " $_";
106 $i++;
107 }
108 print " >\n";
109}
110print "not " if "@r" ne "@s";
111print "ok 10\n";
112EOT