1#!./perl
2
3#
4# test glob() in File::DosGlob
5#
6
7BEGIN {
8    chdir 't' if -d 't';
9    @INC = '../lib';
10}
11
12print "1..10\n";
13
14# override it in main::
15use File::DosGlob 'glob';
16
17# test if $_ takes as the default
18my $expected;
19if ($^O eq 'MacOS') {
20    $expected = $_ = ":op:a*.t";
21} else {
22    $expected = $_ = "op/a*.t";
23}
24my @r = glob;
25print "not " if $_ ne $expected;
26print "ok 1\n";
27print "# |@r|\nnot " if @r < 9;
28print "ok 2\n";
29
30# check if <*/*> works
31if ($^O eq 'MacOS') {
32    @r = <:*:a*.t>;
33} else {
34    @r = <*/a*.t>;
35}
36# atleast {argv,abbrev,anydbm,autoloader,append,arith,array,assignwarn,auto}.t
37print "# |@r|\nnot " if @r < 9;
38print "ok 3\n";
39my $r = scalar @r;
40
41# check if scalar context works
42@r = ();
43while (defined($_ = ($^O eq 'MacOS') ? <:*:a*.t> : <*/a*.t>)) {
44    print "# $_\n";
45    push @r, $_;
46}
47print "not " if @r != $r;
48print "ok 4\n";
49
50# check if list context works
51@r = ();
52if ($^O eq 'MacOS') {
53    for (<:*:a*.t>) {
54    	print "# $_\n";
55    	push @r, $_;
56    }
57} else {
58    for (<*/a*.t>) {
59    	print "# $_\n";
60    	push @r, $_;
61    }
62}
63print "not " if @r != $r;
64print "ok 5\n";
65
66# test if implicit assign to $_ in while() works
67@r = ();
68if ($^O eq 'MacOS') {
69    while (<:*:a*.t>) {
70    	print "# $_\n";
71	push @r, $_;
72    }
73} else {
74    while (<*/a*.t>) {
75    	print "# $_\n";
76	push @r, $_;
77    }
78}
79print "not " if @r != $r;
80print "ok 6\n";
81
82# test if explicit glob() gets assign magic too
83my @s = ();
84my $pat = ($^O eq 'MacOS') ? ':*:a*.t': '*/a*.t';
85while (glob ($pat)) {
86    print "# $_\n";
87    push @s, $_;
88}
89print "not " if "@r" ne "@s";
90print "ok 7\n";
91
92# how about in a different package, like?
93package Foo;
94use File::DosGlob 'glob';
95@s = ();
96$pat = $^O eq 'MacOS' ? ':*:a*.t' : '*/a*.t';
97while (glob($pat)) {
98    print "# $_\n";
99    push @s, $_;
100}
101print "not " if "@r" ne "@s";
102print "ok 8\n";
103
104# test if different glob ops maintain independent contexts
105@s = ();
106if ($^O eq 'MacOS') {
107    while (<:*:a*.t>) {
108	my $i = 0;
109	print "# $_ <";
110	push @s, $_;
111	while (<:*:b*.t>) {
112	    print " $_";
113	    $i++;
114	}
115	print " >\n";
116    }
117} else {
118    while (<*/a*.t>) {
119	my $i = 0;
120	print "# $_ <";
121	push @s, $_;
122	while (<*/b*.t>) {
123	    print " $_";
124	    $i++;
125	}
126	print " >\n";
127    }
128}
129print "not " if "@r" ne "@s";
130print "ok 9\n";
131
132# how about a global override, hm?
133eval <<'EOT';
134use File::DosGlob 'GLOBAL_glob';
135package Bar;
136@s = ();
137if ($^O eq 'MacOS') {
138    while (<:*:a*.t>) {
139	my $i = 0;
140	print "# $_ <";
141	push @s, $_;
142	while (glob ':*:b*.t') {
143	    print " $_";
144	    $i++;
145	}
146	print " >\n";
147    }
148} else {
149    while (<*/a*.t>) {
150	my $i = 0;
151	print "# $_ <";
152	push @s, $_;
153	while (glob '*/b*.t') {
154	    print " $_";
155	    $i++;
156	}
157	print " >\n";
158    }
159}
160print "not " if "@r" ne "@s";
161print "ok 10\n";
162EOT
163