various File::Glob fixes for DOSISH platforms
[p5sagit/p5-mst-13.2.git] / t / lib / glob-global.t
CommitLineData
72b16652 1#!./perl
2
3BEGIN {
4 chdir 't' if -d 't';
5 unshift @INC, '../lib';
6
7 print "1..10\n";
8}
9END {
10 print "not ok 1\n" unless $loaded;
11}
12
13BEGIN {
14 *CORE::GLOBAL::glob = sub { "Just another Perl hacker," };
15}
16
17BEGIN {
18 if ("Just another Perl hacker," ne (<*>)[0]) {
19 die <<EOMessage;
20Your version of perl ($]) doesn't seem to allow extensions to override
21the core glob operator.
22EOMessage
23 }
24}
25
220398a0 26use File::Glob ':globally';
72b16652 27$loaded = 1;
28print "ok 1\n";
29
30$_ = "lib/*.t";
31my @r = glob;
32print "not " if $_ ne 'lib/*.t';
33print "ok 2\n";
34
35# we should have at least basic.t, global.t, taint.t
36print "# |@r|\nnot " if @r < 3;
37print "ok 3\n";
38
39# check if <*/*> works
40@r = <*/*.t>;
41# at least t/global.t t/basic.t, t/taint.t
42print "not " if @r < 3;
43print "ok 4\n";
44my $r = scalar @r;
45
46# check if scalar context works
47@r = ();
48while (defined($_ = <*/*.t>)) {
49 #print "# $_\n";
50 push @r, $_;
51}
52print "not " if @r != $r;
53print "ok 5\n";
54
55# check if array context works
56@r = ();
57for (<*/*.t>) {
58 #print "# $_\n";
59 push @r, $_;
60}
61print "not " if @r != $r;
62print "ok 6\n";
63
64# test if implicit assign to $_ in while() works
65@r = ();
66while (<*/*.t>) {
67 #print "# $_\n";
68 push @r, $_;
69}
70print "not " if @r != $r;
71print "ok 7\n";
72
73# test if explicit glob() gets assign magic too
74my @s = ();
75while (glob '*/*.t') {
76 #print "# $_\n";
77 push @s, $_;
78}
79print "not " if "@r" ne "@s";
80print "ok 8\n";
81
82# how about in a different package, like?
83package Foo;
220398a0 84use File::Glob ':globally';
72b16652 85@s = ();
86while (glob '*/*.t') {
87 #print "# $_\n";
88 push @s, $_;
89}
90print "not " if "@r" ne "@s";
91print "ok 9\n";
92
93# test if different glob ops maintain independent contexts
94@s = ();
95my $i = 0;
96while (<*/*.t>) {
97 #print "# $_ <";
98 push @s, $_;
99 while (<bas*/*.t>) {
100 #print " $_";
101 $i++;
102 }
103 #print " >\n";
104}
105print "not " if "@r" ne "@s" or not $i;
106print "ok 10\n";