MPE/iX fixes from Mark Bixby (a Configure fix is also needed.)
[p5sagit/p5-mst-13.2.git] / lib / File / 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
b695f709 18$_ = "op/a*.t";
fb73857a 19my @r = glob;
b695f709 20print "not " if $_ ne 'op/a*.t';
fb73857a 21print "ok 1\n";
b695f709 22print "# |@r|\nnot " if @r < 9;
fb73857a 23print "ok 2\n";
24
25# check if <*/*> works
26@r = <*/a*.t>;
27# atleast {argv,abbrev,anydbm,autoloader,append,arith,array,assignwarn,auto}.t
28print "not " if @r < 9;
29print "ok 3\n";
30my $r = scalar @r;
31
32# check if scalar context works
33@r = ();
34while (defined($_ = <*/a*.t>)) {
35 print "# $_\n";
36 push @r, $_;
37}
38print "not " if @r != $r;
39print "ok 4\n";
40
91e74348 41# check if list context works
fb73857a 42@r = ();
43for (<*/a*.t>) {
44 print "# $_\n";
45 push @r, $_;
46}
47print "not " if @r != $r;
48print "ok 5\n";
49
50# test if implicit assign to $_ in while() works
51@r = ();
52while (<*/a*.t>) {
53 print "# $_\n";
54 push @r, $_;
55}
56print "not " if @r != $r;
57print "ok 6\n";
58
59# test if explicit glob() gets assign magic too
60my @s = ();
61while (glob '*/a*.t') {
62 print "# $_\n";
63 push @s, $_;
64}
65print "not " if "@r" ne "@s";
66print "ok 7\n";
67
68# how about in a different package, like?
69package Foo;
70use File::DosGlob 'glob';
71@s = ();
72while (glob '*/a*.t') {
73 print "# $_\n";
74 push @s, $_;
75}
76print "not " if "@r" ne "@s";
77print "ok 8\n";
78
79# test if different glob ops maintain independent contexts
80@s = ();
81while (<*/a*.t>) {
82 my $i = 0;
83 print "# $_ <";
84 push @s, $_;
85 while (<*/b*.t>) {
86 print " $_";
87 $i++;
88 }
89 print " >\n";
90}
91print "not " if "@r" ne "@s";
92print "ok 9\n";
93
95d94a4f 94# how about a global override, hm?
95eval <<'EOT';
96use File::DosGlob 'GLOBAL_glob';
97package Bar;
98@s = ();
99while (<*/a*.t>) {
100 my $i = 0;
101 print "# $_ <";
102 push @s, $_;
103 while (glob '*/b*.t') {
104 print " $_";
105 $i++;
106 }
107 print " >\n";
108}
109print "not " if "@r" ne "@s";
110print "ok 10\n";
111EOT