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