View | Details | Raw Unified | Return to bug 39365
Collapse All | Expand All

(-)a/xt/pl_valid.t (-1 / +83 lines)
Line 0 Link Here
0
- 
1
#!/usr/bin/env perl
2
3
# This file is part of Koha.
4
#
5
# Koha is free software; you can redistribute it and/or modify it
6
# under the terms of the GNU General Public License as published by
7
# the Free Software Foundation; either version 3 of the License, or
8
# (at your option) any later version.
9
#
10
# Koha is distributed in the hope that it will be useful, but
11
# WITHOUT ANY WARRANTY; without even the implied warranty of
12
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
13
# GNU General Public License for more details.
14
#
15
# You should have received a copy of the GNU General Public License
16
# along with Koha; if not, see <http://www.gnu.org/licenses>.
17
18
use Modern::Perl;
19
use threads;    # used for parallel
20
use Test::More;
21
use Test::NoWarnings;
22
use Pod::Checker;
23
24
use Parallel::ForkManager;
25
use Sys::CPU;
26
27
my @files;
28
push @files, qx{git ls-files '*.pl' '*.PL' '*.pm' '*.t'};
29
push @files, qx{git ls-files svc opac/svc};                 # Files without extension
30
chomp for @files;
31
32
my @exceptions = qw(
33
    Koha/Account/Credit.pm
34
    Koha/Account/Debit.pm
35
    Koha/Old/Hold.pm
36
    misc/translator/TmplTokenizer.pm
37
);
38
39
my $ncpu;
40
if ( $ENV{KOHA_PROVE_CPUS} ) {
41
    $ncpu = $ENV{KOHA_PROVE_CPUS};
42
} else {
43
    $ncpu = Sys::CPU::cpu_count();
44
}
45
46
my $pm = Parallel::ForkManager->new($ncpu);
47
48
plan tests => scalar(@files) + 1;
49
50
for my $file (@files) {
51
    if ( grep { $file eq $_ } @exceptions ) {
52
        pass("$file is skipped - exception");
53
        next;
54
    }
55
    $pm->start and next;
56
    my $output = `perl -cw '$file' 2>&1`;
57
    chomp $output;
58
    if ($?) {
59
        fail("$file has syntax errors");
60
        diag($output);
61
    } elsif ( $output =~ /^$file syntax OK$/ ) {
62
        pass("$file passed syntax check");
63
    } else {
64
        my @fails;
65
        for my $line ( split "\n", $output ) {
66
            next if $line =~ m{^$file syntax OK$};
67
            next if $line =~ m{^Subroutine .* redefined at};
68
            next if $line =~ m{^Constant subroutine .* redefined at};
69
70
            next if $line =~ m{Name "Lingua::Ispell::path" used only once: possible typo at C4/Tags.pm};
71
            push @fails, $line;
72
        }
73
        if (@fails) {
74
            fail("$file has syntax warnings.");
75
            diag( join "\n", @fails );
76
        } else {
77
            pass("$file passed syntax check");
78
        }
79
    }
80
    $pm->finish;
81
}
82
83
$pm->wait_all_children;

Return to bug 39365