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

(-)a/C4/Installer/PerlDependencies.pm (+10 lines)
Lines 169-174 our $PERL_DEPS = { Link Here
169
        'required' => '1',
169
        'required' => '1',
170
        'min_ver'  => '2.56'
170
        'min_ver'  => '2.56'
171
    },
171
    },
172
    'TAP::Harness::JUnit' => {
173
        'usage'    => 'Core',
174
        'required' => '1',
175
        'min_ver'  => '0.42',
176
    },
172
    'PDF::API2::Util' => {
177
    'PDF::API2::Util' => {
173
        'usage'    => 'Core',
178
        'usage'    => 'Core',
174
        'required' => '1',
179
        'required' => '1',
Lines 757-762 our $PERL_DEPS = { Link Here
757
        'required' => '0',
762
        'required' => '0',
758
        'min_ver'  => '0.89',
763
        'min_ver'  => '0.89',
759
    },
764
    },
765
    'Devel::Cover::Report::Clover' => {
766
        'usage'    => 'Test code coverage',
767
        'required' => '1',
768
        'min_ver'  => '1.01',
769
    },
760
    'Log::Log4perl' => {
770
    'Log::Log4perl' => {
761
        'usage'    => 'Core',
771
        'usage'    => 'Core',
762
        'required' => '1',
772
        'required' => '1',
(-)a/ks-test-harness.pl (-1 / +285 lines)
Line 0 Link Here
0
- 
1
#!/usr/bin/env perl
2
3
# Copyright 2017 KohaSuomi
4
#
5
# This file is part of Koha.
6
#
7
8
use 5.22.0;
9
use Carp;
10
use autodie;
11
$Carp::Verbose = 'true'; #die with stack trace
12
use English; #Use verbose alternatives for perl's strange $0 and $\ etc.
13
use Getopt::Long qw(:config no_ignore_case);
14
15
my ($help, $dryRun);
16
my ($verbose, $gitTailLength) = (0, 0);
17
my ($clover, $tar);
18
my ($testAll, $testBasic, $testXt, $testSip2, $testDb);
19
20
21
GetOptions(
22
    'h|help'                      => \$help,
23
    'v|verbose:i'                 => \$verbose,
24
    'dry-run'                     => \$dryRun,
25
    'clover'                      => \$clover,
26
    'tar'                         => \$tar,
27
    'a|all'                       => \$testAll,
28
    'b|basic'                     => \$testBasic,
29
    'x|xt'                        => \$testXt,
30
    's|sip2'                      => \$testSip2,
31
    'd|db'                        => \$testDb,
32
    'g|git:i'                     => \$gitTailLength,
33
);
34
35
my $usage = <<USAGE;
36
37
Runs a ton of tests with other metrics if needed
38
39
  -h --help             This friendly help!
40
41
  -v --verbose          Integer, the level of verbosity
42
43
  --tar                 Create a testResults.tar.gz from all tests and deliverables
44
45
  --dry-run             Don't run tests or other metrics. Simply show what would happen.
46
47
  --clover              Run Devel::Cover and output Clover-reports
48
49
  -a --all              Run all tests.
50
51
  -b --basic            Basic tests t/*.t
52
53
  -x --xt               XT tests
54
55
  -s --sip2             SIP2 tests
56
57
  -d --db               db_dependent tests
58
59
  --git                 Integer, look for this many git commits from HEAD and run
60
                        all '.t'-files that they have changed.
61
                        This is meaningful as a quick smoke test to verify that
62
                        the latest changes haven't been broken or work as expected.
63
                        Thus where the most probably reason for breakage occurs,
64
                        is tested first, before executing more lengthy test suites.
65
66
EXAMPLE
67
68
    ##First run a smoke test for latest changes
69
    ks-test-harness.pl --git 5 --tar
70
    ##Then run a big test suite
71
    ks-test-harness.pl --all --tar
72
73
    ##Just fiddling with options here
74
    ks-test-harness.pl --basic --db -v 1
75
76
USAGE
77
78
if ($help) {
79
    print $usage;
80
    exit 0;
81
}
82
83
use File::Basename;
84
use TAP::Harness::JUnit;
85
use Git;
86
87
my $dir = File::Basename::dirname($0);
88
chdir $dir;
89
90
91
##Prepare directories to store test results
92
my $testResultsDir = 'testResults';
93
my $testResultsArchive = 'testResults.tar.gz';
94
my $junitDir =  $testResultsDir.'/junit';
95
my $cloverDir = $testResultsDir.'/clover';
96
my @archivableDirs = ($junitDir, $cloverDir);
97
mkdir $testResultsDir unless -d $testResultsDir;
98
_shell("rm -r $junitDir");
99
_shell("rm -r $cloverDir");
100
mkdir $junitDir unless -d $junitDir;
101
mkdir $cloverDir unless -d $cloverDir;
102
unlink $testResultsArchive if -e $testResultsArchive;
103
104
105
run();
106
sub run {
107
    clearCoverDb() if $clover;
108
    runharness(_getAllTests()) if $testAll;
109
    runharness(_getBasicTests()) if $testBasic;
110
    runharness(_getXTTests()) if $testXt;
111
    runharness(_getSIPTests()) if $testSip2;
112
    runharness(_getDbDependentTests()) if $testDb;
113
    runharness(_getGitTailTests()) if $gitTailLength;
114
    createCoverReport() if $clover;
115
    tar() if $tar;
116
}
117
118
=head2 clearCoverDb
119
120
Empty previous coverage test results
121
122
=cut
123
124
sub clearCoverDb {
125
    my $cmd = "/usr/bin/cover -delete $testResultsDir/cover_db";
126
    print "$cmd\n" if $dryRun;
127
    _shell($cmd) unless $dryRun;
128
}
129
130
=head2 createCoverReport
131
132
Create Clover coverage reports
133
134
=cut
135
136
sub createCoverReport {
137
    my $cmd = "/usr/bin/cover -report clover -outputdir $testResultsDir/clover $testResultsDir/cover_db";
138
    print "$cmd\n" if $dryRun;
139
    _shell($cmd) unless $dryRun;
140
}
141
142
=head2 tar
143
144
Create a tar.gz-package out of test deliverables
145
146
=cut
147
148
sub tar {
149
    my $cmd = "/bin/tar -czf $testResultsArchive @archivableDirs";
150
    print "$cmd\n" if $dryRun;
151
    _shell($cmd) unless $dryRun;
152
}
153
154
=head2 runharness
155
156
Runs all given test files
157
158
=cut
159
160
sub runharness {
161
    my ($files) = @_;
162
    unless (ref($files) eq 'HASH') {
163
        carp "\$files is not a HASHRef";
164
    }
165
166
    foreach my $dir (sort keys %$files) {
167
        my @tests = sort @{$files->{$dir}};
168
        unless (scalar(@tests)) {
169
            carp "\@tests is empty?";
170
        }
171
172
        ##Prepare test harness params
173
        my $dirToPackage = $dir;
174
        $dirToPackage =~ s!^\./!!; #Drop leading "current"-dir chars
175
        $dirToPackage =~ s!/!\.!gsm; #Change directories to dot-separated packages
176
        my $xmlfile = $testResultsDir.'/junit'.'/'.$dirToPackage.'.xml';
177
        my @exec = (
178
            $EXECUTABLE_NAME,
179
            '-w',
180
        );
181
        push(@exec, '-MDevel::Cover=-silent,1,-coverage,all') if $clover;
182
183
        if ($dryRun) {
184
            print "TAP::Harness::JUnit would run tests with this config:\nxmlfile => $xmlfile\npackage => $dirToPackage\nexec => @exec\ntests => @tests\n";
185
        }
186
        else {
187
            my $harness = TAP::Harness::JUnit->new({
188
                xmlfile => $xmlfile,
189
#                package => $dirToPackage,
190
                package => "",
191
                verbosity => 1,
192
                namemangle => 'perl',
193
                exec       => \@exec,
194
            });
195
            $harness->runtests(@tests);
196
        }
197
    }
198
}
199
200
sub _getAllTests {
201
    return _getTests('.', '*.t');
202
}
203
sub _getBasicTests {
204
    return _getTests('t', '*.t', 1); #maxdepth 1
205
}
206
sub _getXTTests {
207
    return _getTests('xt', '*.t');
208
}
209
sub _getSIPTests {
210
    return _getTests('C4/SIP/t', '*.t');
211
}
212
sub _getDbDependentTests {
213
    return _getTests('t/db_dependent', '*.t');
214
}
215
sub _getTests {
216
    my ($dir, $selector, $maxDepth) = @_;
217
    $maxDepth = 999 unless(defined($maxDepth));
218
    my $files = _shell("/usr/bin/find $dir -name '$selector' -maxdepth $maxDepth");
219
    my @files = split(/\n/, $files);
220
    return _sortFilesByDir(\@files);
221
}
222
sub _getGitTailTests {
223
    my $repo = Git->repository(Directory => '.');
224
    #We can read and print 10000 git commits in less than three seconds :) good Git!
225
    my @commits = $repo->command('show', '--pretty=oneline', '--no-patch', '-'.($gitTailLength+1)); #Diff tree needs to include one extra commit to diff properly.
226
    my $lastCommitHash = $commits[-1];
227
    if ($lastCommitHash =~ /^(\w+)\s/ && length($1) == 40) {
228
        $lastCommitHash = $1;
229
    }
230
    else {
231
        carp "Commit '$lastCommitHash' couldn't be parsed for it's leading commit hash";
232
    }
233
    my @changedFiles = $repo->command('diff-tree', '--no-commit-id', '--name-only', '-r', 'HEAD..'.$lastCommitHash);
234
    my @testFiles;
235
    foreach my $f (@changedFiles) {
236
        if ($f =~ /.+?\.t$/) {
237
            push(@testFiles, $f);
238
        }
239
    }
240
    print "Found these changed test files in Git history: @testFiles\n" if $verbose > 0;
241
    return {} unless scalar(@testFiles);
242
    return _sortFilesByDir(\@testFiles);
243
}
244
245
sub _shell {
246
    my (@cmd) = @_;
247
    my $rv = `@cmd`;
248
    my $exitCode = ${^CHILD_ERROR_NATIVE} >> 8;
249
    my $killSignal = ${^CHILD_ERROR_NATIVE} & 127;
250
    my $coreDumpTriggered = ${^CHILD_ERROR_NATIVE} & 128;
251
    warn "Shell command: @cmd\n  exited with code '$exitCode'. Killed by signal '$killSignal'.".(($coreDumpTriggered) ? ' Core dumped.' : '')."\n  STDOUT: $rv\n"
252
        if $exitCode != 0;
253
    print "@cmd\n$rv\n" if $rv && $verbose > 0;
254
    return $rv;
255
}
256
257
=head2 _sortFilesByDir
258
259
Sort files in arrays by directory
260
@RETURNS HASHRef of directory-name keys and test file names
261
        {
262
            't/db_dependent' => [
263
                't/db_dependent/01-test.t',
264
            ],
265
            ...
266
        }
267
=cut
268
269
sub _sortFilesByDir {
270
    my ($files) = @_;
271
    unless (ref($files) eq 'ARRAY') {
272
        carp "\$files is not an ARRAYRef";
273
    }
274
    unless (scalar(@$files)) {
275
        carp "\$files is an ampty array?";
276
    }
277
278
    my %dirsWithFiles;
279
    foreach my $f (@$files) {
280
        my $dir = File::Basename::dirname($f);
281
        $dirsWithFiles{$dir} = [] unless $dirsWithFiles{$dir};
282
        push (@{$dirsWithFiles{$dir}}, $f);
283
    }
284
    return \%dirsWithFiles;
285
}

Return to bug 18238