File Coverage

lib/Test/Spelling/Comment.pm
Criterion Covered Total %
statement 99 99 100.0
branch 25 26 96.1
condition 6 6 100.0
subroutine 14 14 100.0
pod 3 3 100.0
total 147 148 99.3


line stmt bran cond sub pod time code
1             package Test::Spelling::Comment;
2              
3 9     9   658404 use 5.006;
  9         107  
4 9     9   49 use strict;
  9         30  
  9         216  
5 9     9   45 use warnings;
  9         25  
  9         446  
6              
7             our $VERSION = '0.005';
8              
9 9     9   5009 use Moo;
  9         101084  
  9         47  
10              
11 9     9   13079 use Carp ();
  9         25  
  9         139  
12 9     9   4069 use Comment::Spell::Check ();
  9         6125675  
  9         242  
13 9     9   104 use Pod::Wordlist ();
  9         20  
  9         150  
14 9     9   50 use Scalar::Util ();
  9         20  
  9         128  
15 9     9   43 use Test::Builder ();
  9         29  
  9         156  
16 9     9   4118 use Test::XTFiles ();
  9         123602  
  9         7249  
17              
18             has _skip => (
19             is => 'ro',
20             init_arg => 'skip',
21             );
22              
23             has _stopwords => (
24             is => 'ro',
25             isa => sub { Carp::croak q{stopwords must have method 'wordlist'} if !Scalar::Util::blessed( $_[0] ) || !$_[0]->can('wordlist'); },
26             init_arg => 'stopwords',
27             lazy => 1,
28             default => sub { Pod::Wordlist->new },
29             predicate => 1,
30             );
31              
32             my $TEST = Test::Builder->new();
33              
34             # - Do not use subtests because subtests cannot be tested with
35             # Test::Builder:Tester.
36             # - Do not use a plan because a method that sets a plan cannot be tested
37             # with Test::Builder:Tester.
38             # - Do not call done_testing in a method that should be tested by
39             # Test::Builder::Tester because TBT cannot test them.
40              
41             sub add_stopwords {
42 6     6 1 11861 my $self = shift;
43              
44 6         147 my $wordlist = $self->_stopwords->wordlist;
45              
46             STOPWORD:
47 6         2647 for (@_) {
48              
49             # explicit copy
50 9         17 my $stopword = $_;
51 9         45 $stopword =~ s{ ^ \s* }{}xsm;
52 9         34 $stopword =~ s{ \s+ $ }{}xsm;
53 9 50       28 next STOPWORD if $stopword eq q{};
54              
55 9         27 $wordlist->{$stopword} = 1;
56             }
57              
58 6         51 return $self;
59             }
60              
61             sub all_files_ok {
62 3     3 1 5748 my ($self) = @_;
63              
64 3         53 my @files = Test::XTFiles->new->all_files();
65 3 100       20691 if ( !@files ) {
66 1         17 $TEST->skip_all("No files found\n");
67 1         11 return 1;
68             }
69              
70 2         35 my $rc = 1;
71 2         6 for my $file (@files) {
72 3 100       22 if ( !$self->file_ok($file) ) {
73 1         11 $rc = 0;
74             }
75             }
76              
77 2         16 $TEST->done_testing;
78              
79 2 100       18 return 1 if $rc;
80 1         8 return;
81             }
82              
83             sub file_ok {
84 15     15 1 50835 my ( $self, $file ) = @_;
85              
86 15 100 100     439 Carp::croak 'usage: file_ok(FILE)' if @_ != 2 || !defined $file;
87              
88 12 100       253 if ( !-f $file ) {
89 1         7 $TEST->ok( 0, $file );
90 1         1050 $TEST->diag("\n");
91 1         242 $TEST->diag("File $file does not exist or is not a file");
92              
93 1         236 return;
94             }
95              
96 11         33 my $fh;
97 11 100       371 if ( !open $fh, '<', $file ) {
98 1         10 $TEST->ok( 0, $file );
99 1         1211 $TEST->diag("\n");
100 1         295 $TEST->diag("Cannot read file '$file': $!");
101              
102 1         239 return;
103             }
104              
105 10         273 my @lines = <$fh>;
106 10         42 chomp @lines;
107              
108 10 100       95 if ( !close $fh ) {
109 1         12 $TEST->ok( 0, $file );
110 1         1260 $TEST->diag("\n");
111 1         245 $TEST->diag("Cannot read file '$file': $!");
112              
113 1         249 return;
114             }
115              
116 9         36 my $skips_ref = $self->_skip;
117 9 100       25 if ( defined $skips_ref ) {
118 5 100 100     40 if ( ( !defined Scalar::Util::reftype($skips_ref) )
119             || ( Scalar::Util::reftype($skips_ref) ne Scalar::Util::reftype( [] ) ) )
120             {
121 3         7 $skips_ref = [$skips_ref];
122             }
123              
124 5         15 for my $line (@lines) {
125 20         26 for my $skip ( @{$skips_ref} ) {
  20         38  
126             ## no critic (RegularExpressions::RequireDotMatchAnything)
127             ## no critic (RegularExpressions::RequireExtendedFormatting)
128             ## no critic (RegularExpressions::RequireLineBoundaryMatching)
129 28         185 $line =~ s{$skip}{}g;
130             ## use critic
131             }
132             }
133             }
134              
135 9 100       230 my $speller = Comment::Spell::Check->new( $self->_has_stopwords ? ( stopwords => $self->_stopwords ) : () );
136 9         2189 my $buf;
137 9         41 $speller->set_output_string($buf);
138 9         522 my $result;
139 9 100       19 if ( !eval { $result = $speller->parse_from_string( join "\n", @lines, q{} ); 1 } ) {
  9         45  
  7         163  
140 2         17 my $error_msg = $@;
141 2         9 $TEST->ok( 0, $file );
142 2         1951 $TEST->diag("\n$error_msg\n\n");
143              
144 2         514 return;
145             }
146              
147 7 100       13 if ( @{ $result->{fails} } == 0 ) {
  7         21  
148 6         28 $TEST->ok( 1, $file );
149              
150 6         1569 return 1;
151             }
152              
153 1         12 $TEST->ok( 0, $file );
154 1         998 $TEST->diag("\n$buf\n\n");
155              
156 1         310 return;
157             }
158              
159 9     9   87 no Moo;
  9         25  
  9         69  
160              
161             1;
162              
163             __END__