This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
625d107ebe5e07a1744b8545774505a74b0217d0
[perl5.git] / lib / File / DosGlob.t
1 #!./perl
2
3 #
4 # test glob() in File::DosGlob
5 #
6
7 BEGIN {
8     chdir 't' if -d 't';
9     @INC = '../lib';
10 }
11
12 print "1..10\n";
13
14 # override it in main::
15 use File::DosGlob 'glob';
16
17 # test if $_ takes as the default
18 my $expected;
19 if ($^O eq 'MacOS') {
20     $expected = $_ = ":op:a*.t";
21 } else {
22     $expected = $_ = "op/a*.t";
23 }
24 my @r = glob;
25 print "not " if $_ ne $expected;
26 print "ok 1\n";
27 print "# |@r|\nnot " if @r < 9;
28 print "ok 2\n";
29
30 # check if <*/*> works
31 if ($^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
37 print "# |@r|\nnot " if @r < 9;
38 print "ok 3\n";
39 my $r = scalar @r;
40
41 # check if scalar context works
42 @r = ();
43 while (defined($_ = ($^O eq 'MacOS') ? <:*:a*.t> : <*/a*.t>)) {
44     print "# $_\n";
45     push @r, $_;
46 }
47 print "not " if @r != $r;
48 print "ok 4\n";
49
50 # check if list context works
51 @r = ();
52 if ($^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 }
63 print "not " if @r != $r;
64 print "ok 5\n";
65
66 # test if implicit assign to $_ in while() works
67 @r = ();
68 if ($^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 }
79 print "not " if @r != $r;
80 print "ok 6\n";
81
82 # test if explicit glob() gets assign magic too
83 my @s = ();
84 my $pat = ($^O eq 'MacOS') ? ':*:a*.t': '*/a*.t';
85 while (glob ($pat)) {
86     print "# $_\n";
87     push @s, $_;
88 }
89 print "not " if "@r" ne "@s";
90 print "ok 7\n";
91
92 # how about in a different package, like?
93 package Foo;
94 use File::DosGlob 'glob';
95 @s = ();
96 $pat = $^O eq 'MacOS' ? ':*:a*.t' : '*/a*.t';
97 while (glob($pat)) {
98     print "# $_\n";
99     push @s, $_;
100 }
101 print "not " if "@r" ne "@s";
102 print "ok 8\n";
103
104 # test if different glob ops maintain independent contexts
105 @s = ();
106 if ($^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 }
129 print "not " if "@r" ne "@s";
130 print "ok 9\n";
131
132 # how about a global override, hm?
133 eval <<'EOT';
134 use File::DosGlob 'GLOBAL_glob';
135 package Bar;
136 @s = ();
137 if ($^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 }
160 print "not " if "@r" ne "@s";
161 print "ok 10\n";
162 EOT