This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Convert all File::Glob tests to Test::More.
[perl5.git] / ext / File-Glob / t / global.t
1 #!./perl
2
3 BEGIN {
4     chdir 't' if -d 't';
5     @INC = '../lib';
6     require Config; import Config;
7     if ($Config{'extensions'} !~ /\bFile\/Glob\b/i) {
8         print "1..0\n";
9         exit 0;
10     }
11 }
12
13 use Test::More tests => 11;
14
15 BEGIN {
16     *CORE::GLOBAL::glob = sub { "Just another Perl hacker," };
17 }
18
19 BEGIN {
20     if ("Just another Perl hacker," ne (<*>)[0]) {
21         die <<EOMessage;
22 Your version of perl ($]) doesn't seem to allow extensions to override
23 the core glob operator.
24 EOMessage
25     }
26 }
27
28 BEGIN {
29     use_ok('File::Glob', ':globally');
30 }
31
32 $_ = "op/*.t";
33 my @r = glob;
34 is($_, "op/*.t");
35
36 cmp_ok(scalar @r, '>=', 3);
37
38 @r = <*/*.t>;
39 # at least t/global.t t/basic.t, t/taint.t
40 cmp_ok(scalar @r, '>=', 3, 'check if <*/*> works');
41 my $r = scalar @r;
42
43 @r = ();
44 while (defined($_ = <*/*.t>)) {
45   #print "# $_\n";
46   push @r, $_;
47 }
48 is(scalar @r, $r, 'check if scalar context works');
49
50 @r = ();
51 for (<*/*.t>) {
52   #print "# $_\n";
53   push @r, $_;
54 }
55 is(scalar @r, $r, 'check if list context works');
56
57 @r = ();
58 while (<*/*.t>) {
59   #print "# $_\n";
60   push @r, $_;
61 }
62 is(scalar @r, $r, 'implicit assign to $_ in while()');
63
64 my @s = ();
65 while (glob('*/*.t')) {
66     #print "# $_\n";
67     push @s, $_;
68 }
69 is("@r", "@s", 'explicit glob() gets assign magic too');
70
71 package Foo;
72 use File::Glob ':globally';
73 @s = ();
74 while (glob('*/*.t')) {
75     #print "# $_\n";
76     push @s, $_;
77 }
78 main::is("@r", "@s", 'in a different package');
79
80 # test if different glob ops maintain independent contexts
81 @s = ();
82 my $i = 0;
83 while (<*/*.t>) {
84   #print "# $_ <";
85   push @s, $_;
86   while (<bas*/*.t>) {
87     #print " $_";
88     $i++;
89   }
90   #print " >\n";
91 }
92
93 main::is("@r", "@s", 'different glob ops maintain independent contexts');
94 main::isnt($i, 0, 'different glob ops maintain independent contexts');