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   659  
  1         1  
  1         34  
4 1     1   5 use warnings;
  1         2  
  1         27  
5 1     1   5 use strict;
  1         3  
  1         18  
6 1     1   5 use Test::Builder;
  1         1  
  1         20  
7 1     1   724 use File::Spec;
  1         1454  
  1         8  
8             use UNIVERSAL::require;
9              
10              
11             our $VERSION = '0.04';
12              
13              
14             my $Test = Test::Builder->new;
15              
16              
17 1     1   7 sub import {
18 1         2 my $self = shift;
19             my $caller = caller;
20 1         2  
21 1     1   69 for my $func ( qw( pm_file_ok all_pm_files all_pm_files_ok ) ) {
  1         2  
  1         567  
22 3         5 no strict 'refs';
  3         13  
23             *{$caller."::".$func} = \&$func;
24             }
25 1         5  
26 1         11 $Test->exported_to($caller);
27             $Test->plan(@_);
28             }
29              
30              
31 1     1 1 1 sub pm_file_ok {
32 1 50       4 my $file = shift;
33             my $name = @_ ? shift : "Compile test for $file";
34 1 50       15  
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         8 my $ok = 1;
47 1 50       6 $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         5  
55 1 50       267 $Test->ok($ok, $name);
56 1         4 $Test->diag($diag) unless $ok;
57             $ok;
58             }
59              
60              
61 1 50   1 1 16 sub all_pm_files_ok {
62             my @files = @_ ? @_ : all_pm_files();
63 1         5  
64             $Test->plan(tests => scalar @files);
65 1         101  
66 1         3 my $ok = 1;
67 1 50       2 for (@files) {
68             pm_file_ok($_) or undef $ok;
69 1         86 }
70             $ok;
71             }
72              
73              
74 1 50   1 1 7 sub all_pm_files {
75 1         2 my @queue = @_ ? @_ : _starting_points();
76             my @pm;
77 1         2  
78 26         35 while ( @queue ) {
79 26 100       311 my $file = shift @queue;
80 17         35 if ( -d $file ) {
81 17 50       312 local *DH;
82 17         172 opendir DH, $file or next;
83 17         142 my @newfiles = readdir DH;
84             closedir DH;
85 17         159  
86 17 50       45 @newfiles = File::Spec->no_upwards(@newfiles);
  25         110  
87             @newfiles = grep { $_ ne "CVS" && $_ ne ".svn" } @newfiles;
88 17         548  
89 25         248 for my $newfile (@newfiles) {
90 25 100       363 my $filename = File::Spec->catfile($file, $newfile);
91 9         34 if (-f $filename) {
92             push @queue, $filename;
93 16         112 } else {
94             push @queue, File::Spec->catdir($file, $newfile);
95             }
96             }
97 26 100       360 }
98 9 100       35 if (-f $file) {
99             push @pm, $file if $file =~ /\.pm$/;
100             }
101 1         2 }
102             return @pm;
103             }
104              
105              
106 1 50   1   16 sub _starting_points {
107 0           return 'blib' if -e 'blib';
108             return 'lib';
109             }
110              
111              
112             1;
113              
114             __END__