File Coverage

File:lib/CheckSpelling/CheckPattern.pm
Coverage:100.0%

linestmtbrancondsubtimecode
1#! -*-perl-*-
2
3package CheckSpelling::CheckPattern;
4
5
2
2
2
2
110207
1
403
use CheckSpelling::Util;
6
7sub process_line {
8
22
22
2384
    my ($line) = @_;
9
22
11
    chomp $line;
10
22
100
22
    return ($line, '') if $line =~ /^#/;
11
16
100
21
    return ($line, '') unless $line =~ /./;
12
12
13
    my $regex_pattern = qr{^(.*?) in regex; marked by <-- HERE in m/(.*) <-- HERE.*$};
13
12
3
    my $warning;
14
15
12
9
    my $test_line = $line;
16
12
1
7
2
    $test_line =~ s/(\\Q.*?\\E)/ '='x (length $1) /eg;
17
18    local $SIG{__WARN__} = sub {
19
11
11
35
        $warning = $_[0];
20
12
40
    };
21
12
12
100
100
14
94
    if (eval {qr/$test_line/} && ($warning eq '')) {
22
5
0
        our %seen_patterns;
23
5
5
        my $previous_reference = $seen_patterns{$line};
24
5
100
3
        if (defined $previous_reference) {
25
1
0
            my $length = length $line;
26
1
5
            return ('$^', "1 ... $length, Warning - Pattern is the same as pattern on `$previous_reference` (duplicate-pattern)\n");
27        } else {
28
4
10
            $seen_patterns{$line} = "$ARGV:$.";
29        }
30
4
16
        return ($line, '');
31    }
32
7
100
7
    $warning = $@ unless $warning;
33
7
18
    $warning =~ s/(.*?)\n.*/$1/m;
34
7
4
    my $err = $warning;
35
7
6
    chomp $err;
36
7
30
    $err =~ s{$regex_pattern}{$2};
37
7
3
    my $code = $1;
38
7
13
    my $start = $+[2] - $-[2];
39
7
4
    my $end = $start + 1;
40
7
5
    my $wrapped = CheckSpelling::Util::wrap_in_backticks($err);
41
7
100
5
    if ($code =~ /(^Unmatched )(.)$/) {
42
3
3
        $code = $1 . CheckSpelling::Util::wrap_in_backticks($2);
43    }
44
7
26
    return ('$^', "$start ... $end, Warning - $code: $wrapped (bad-regex)\n");
45}
46
47sub reset_seen {
48
8
8
2
    our %seen_patterns;
49
8
6
    %seen_patters = ();
50}
51
521;