File Coverage

/home/pjcj/g/Test-Smoke/perl-current-gcov/ext/File-Glob/t/global.t
Criterion Covered Total %
statement 53 56 94.6
branch 3 6 50.0
condition n/a
subroutine 7 7 100.0
total 63 69 91.3


line stmt bran cond sub time code
1           #!./perl
2            
3           BEGIN {
4 1 50   1 7 chdir 't' if -d 't';
5 1       4 @INC = '../lib';
6 1       5 require Config; import Config;
  1       34  
7 1 50     14 if ($Config{'extensions'} !~ /\bFile\/Glob\b/i) {
8 0       0 print "1..0\n";
9 0       0 exit 0;
10           }
11           }
12            
13 1     1 445 use Test::More tests => 11;
  1       21223  
  1       13  
14            
15           BEGIN {
16 1     1 678 *CORE::GLOBAL::glob = sub { "Just another Perl hacker," };
  1       43  
17           }
18            
19           BEGIN {
20 1 50   1 9 if ("Just another Perl hacker," ne (<*>)[0]) {
21 0       0 die <
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 1     1 29 use_ok('File::Glob', ':globally');
30           }
31            
32 1       114041 $_ = "op/*.t";
33 1       1079 my @r = glob;
34 1       16 is($_, "op/*.t");
35            
36 1       432 cmp_ok(scalar @r, '>=', 3);
37            
38 1       2972 @r = <*/*.t>;
39           # at least t/global.t t/basic.t, t/taint.t
40 1       51 cmp_ok(scalar @r, '>=', 3, 'check if <*/*> works');
41 1       410 my $r = scalar @r;
42            
43 1       33 @r = ();
44 1       2271 while (defined($_ = <*/*.t>)) {
45           #print "# $_\n";
46 494       1940 push @r, $_;
47           }
48 1       7 is(scalar @r, $r, 'check if scalar context works');
49            
50 1       420 @r = ();
51 1       2203 for (<*/*.t>) {
52           #print "# $_\n";
53 494       886 push @r, $_;
54           }
55 1       30 is(scalar @r, $r, 'check if list context works');
56            
57 1       417 @r = ();
58 1       2206 while (<*/*.t>) {
59           #print "# $_\n";
60 494       2036 push @r, $_;
61           }
62 1       7 is(scalar @r, $r, 'implicit assign to $_ in while()');
63            
64 1       494 my @s = ();
65 1       2328 while (glob('*/*.t')) {
66           #print "# $_\n";
67 494       2042 push @s, $_;
68           }
69 1       129 is("@r", "@s", 'explicit glob() gets assign magic too');
70            
71           package Foo;
72 1     1 968 use File::Glob ':globally';
  1       2  
  1       1885  
73 1       438 @s = ();
74 1       2289 while (glob('*/*.t')) {
75           #print "# $_\n";
76 494       1981 push @s, $_;
77           }
78 1       126 main::is("@r", "@s", 'in a different package');
79            
80           # test if different glob ops maintain independent contexts
81 1       425 @s = ();
82 1       3 my $i = 0;
83 1       2278 while (<*/*.t>) {
84           #print "# $_ <";
85 494       1016 push @s, $_;
86 494       34509 while () {
87           #print " $_";
88 3952       16982 $i++;
89           }
90           #print " >\n";
91           }
92            
93 1       144 main::is("@r", "@s", 'different glob ops maintain independent contexts');
94 1       494 main::isnt($i, 0, 'different glob ops maintain independent contexts');