File Coverage

inc/Test/Compile.pm
Criterion Covered Total %
statement 67 72 93.0
branch 19 30 63.3
condition n/a
subroutine 11 11 100.0
pod 3 3 100.0
total 100 116 86.2


line stmt bran cond sub pod time code
1             #line 1
2             package Test::Compile;
3 1     1   910  
  1         2  
  1         38  
4 1     1   6 use warnings;
  1         1  
  1         36  
5 1     1   5 use strict;
  1         2  
  1         19  
6 1     1   19 use Test::Builder;
  1         2  
  1         20  
7 1     1   526 use File::Spec;
  1         2  
  1         12  
8             use UNIVERSAL::require;
9              
10              
11             our $VERSION = '0.05';
12              
13              
14             my $Test = Test::Builder->new;
15              
16              
17 1     1   8 sub import {
18 1         3 my $self = shift;
19             my $caller = caller;
20 1         2  
21 1     1   79 for my $func ( qw( pm_file_ok all_pm_files all_pm_files_ok ) ) {
  1         2  
  1         720  
22 3         7 no strict 'refs';
  3         18  
23             *{$caller."::".$func} = \&$func;
24             }
25 1         6  
26 1         13 $Test->exported_to($caller);
27             $Test->plan(@_);
28             }
29              
30              
31 1     1 1 2 sub pm_file_ok {
32 1 50       5 my $file = shift;
33             my $name = @_ ? shift : "Compile test for $file";
34 1 50       19  
35 0         0 if (!-f $file) {
36 0         0 $Test->ok(0, $name);
37 0         0 $Test->diag("$file does not exist");
38             return;
39             }
40 1         1  
41 1         7 my $module = $file;
42 1         3 $module =~ s!^(blib/)?lib/!!;
43 1         3 $module =~ s!/!::!g;
44             $module =~ s/\.pm$//;
45 1         1  
46 1         7 my $ok = 1;
47 1 50       4 $module->use;
48             $ok = 0 if $@;
49 1         2  
50 1 50       4 my $diag = '';
51 0         0 unless ($ok) {
52             $diag = "couldn't use $module ($file): $@";
53             }
54 1         7  
55 1 50       4867 $Test->ok($ok, $name);
56 1         7 $Test->diag($diag) unless $ok;
57             $ok;
58             }
59              
60              
61 1 50   1 1 23 sub all_pm_files_ok {
62             my @files = @_ ? @_ : all_pm_files();
63 1         5  
64             $Test->plan(tests => scalar @files);
65 1         637  
66 1         3 my $ok = 1;
67 1 50       3 for (@files) {
68             pm_file_ok($_) or undef $ok;
69 1         1598 }
70             $ok;
71             }
72              
73              
74 1 50   1 1 4 sub all_pm_files {
75 1         4 my @queue = @_ ? @_ : _starting_points();
76             my @pm;
77 1         4  
78 26         45 while ( @queue ) {
79 26 100       321 my $file = shift @queue;
80 17         26 if ( -d $file ) {
81 17 50       327 local *DH;
82 17         180 opendir DH, $file or next;
83 17         146 my @newfiles = readdir DH;
84             closedir DH;
85 17         190  
86 17 50       30 @newfiles = File::Spec->no_upwards(@newfiles);
  25         114  
87             @newfiles = grep { $_ ne "CVS" && $_ ne ".svn" } @newfiles;
88 17         28  
89 25         191 for my $newfile (@newfiles) {
90 25 100       383 my $filename = File::Spec->catfile($file, $newfile);
91 9         32 if (-f $filename) {
92             push @queue, $filename;
93 16         111 } else {
94             push @queue, File::Spec->catdir($file, $newfile);
95             }
96             }
97 26 100       342 }
98 9 100       35 if (-f $file) {
99             push @pm, $file if $file =~ /\.pm$/;
100             }
101 1         3 }
102             return @pm;
103             }
104              
105              
106 1 50   1   21 sub _starting_points {
107 0           return 'blib' if -e 'blib';
108             return 'lib';
109             }
110              
111              
112             1;
113              
114             __END__