From 2909610b5cfc508aa57bd58c7512ea6a10d6adc0 Mon Sep 17 00:00:00 2001 From: Olli-Antti Kivilahti Date: Mon, 30 Jan 2017 16:05:07 +0200 Subject: [PATCH] KD-1738 - AnsbileTorpor - Poor man's Ansible Tower - testHarness.pl testHarness.pl for running Koha's tests in petite chunks https://bugs.koha-community.org/show_bug.cgi?id=18238 --- C4/Installer/PerlDependencies.pm | 10 ++ ks-test-harness.pl | 285 +++++++++++++++++++++++++++++++++++++++ 2 files changed, 295 insertions(+) create mode 100755 ks-test-harness.pl diff --git a/C4/Installer/PerlDependencies.pm b/C4/Installer/PerlDependencies.pm index f8a96c4..53b6855 100644 --- a/C4/Installer/PerlDependencies.pm +++ b/C4/Installer/PerlDependencies.pm @@ -169,6 +169,11 @@ our $PERL_DEPS = { 'required' => '1', 'min_ver' => '2.56' }, + 'TAP::Harness::JUnit' => { + 'usage' => 'Core', + 'required' => '1', + 'min_ver' => '0.42', + }, 'PDF::API2::Util' => { 'usage' => 'Core', 'required' => '1', @@ -757,6 +762,11 @@ our $PERL_DEPS = { 'required' => '0', 'min_ver' => '0.89', }, + 'Devel::Cover::Report::Clover' => { + 'usage' => 'Test code coverage', + 'required' => '1', + 'min_ver' => '1.01', + }, 'Log::Log4perl' => { 'usage' => 'Core', 'required' => '1', diff --git a/ks-test-harness.pl b/ks-test-harness.pl new file mode 100755 index 0000000..812f9f8 --- /dev/null +++ b/ks-test-harness.pl @@ -0,0 +1,285 @@ +#!/usr/bin/env perl + +# Copyright 2017 KohaSuomi +# +# This file is part of Koha. +# + +use 5.22.0; +use Carp; +use autodie; +$Carp::Verbose = 'true'; #die with stack trace +use English; #Use verbose alternatives for perl's strange $0 and $\ etc. +use Getopt::Long qw(:config no_ignore_case); + +my ($help, $dryRun); +my ($verbose, $gitTailLength) = (0, 0); +my ($clover, $tar); +my ($testAll, $testBasic, $testXt, $testSip2, $testDb); + + +GetOptions( + 'h|help' => \$help, + 'v|verbose:i' => \$verbose, + 'dry-run' => \$dryRun, + 'clover' => \$clover, + 'tar' => \$tar, + 'a|all' => \$testAll, + 'b|basic' => \$testBasic, + 'x|xt' => \$testXt, + 's|sip2' => \$testSip2, + 'd|db' => \$testDb, + 'g|git:i' => \$gitTailLength, +); + +my $usage = <{$dir}}; + unless (scalar(@tests)) { + carp "\@tests is empty?"; + } + + ##Prepare test harness params + my $dirToPackage = $dir; + $dirToPackage =~ s!^\./!!; #Drop leading "current"-dir chars + $dirToPackage =~ s!/!\.!gsm; #Change directories to dot-separated packages + my $xmlfile = $testResultsDir.'/junit'.'/'.$dirToPackage.'.xml'; + my @exec = ( + $EXECUTABLE_NAME, + '-w', + ); + push(@exec, '-MDevel::Cover=-silent,1,-coverage,all') if $clover; + + if ($dryRun) { + print "TAP::Harness::JUnit would run tests with this config:\nxmlfile => $xmlfile\npackage => $dirToPackage\nexec => @exec\ntests => @tests\n"; + } + else { + my $harness = TAP::Harness::JUnit->new({ + xmlfile => $xmlfile, +# package => $dirToPackage, + package => "", + verbosity => 1, + namemangle => 'perl', + exec => \@exec, + }); + $harness->runtests(@tests); + } + } +} + +sub _getAllTests { + return _getTests('.', '*.t'); +} +sub _getBasicTests { + return _getTests('t', '*.t', 1); #maxdepth 1 +} +sub _getXTTests { + return _getTests('xt', '*.t'); +} +sub _getSIPTests { + return _getTests('C4/SIP/t', '*.t'); +} +sub _getDbDependentTests { + return _getTests('t/db_dependent', '*.t'); +} +sub _getTests { + my ($dir, $selector, $maxDepth) = @_; + $maxDepth = 999 unless(defined($maxDepth)); + my $files = _shell("/usr/bin/find $dir -name '$selector' -maxdepth $maxDepth"); + my @files = split(/\n/, $files); + return _sortFilesByDir(\@files); +} +sub _getGitTailTests { + my $repo = Git->repository(Directory => '.'); + #We can read and print 10000 git commits in less than three seconds :) good Git! + my @commits = $repo->command('show', '--pretty=oneline', '--no-patch', '-'.($gitTailLength+1)); #Diff tree needs to include one extra commit to diff properly. + my $lastCommitHash = $commits[-1]; + if ($lastCommitHash =~ /^(\w+)\s/ && length($1) == 40) { + $lastCommitHash = $1; + } + else { + carp "Commit '$lastCommitHash' couldn't be parsed for it's leading commit hash"; + } + my @changedFiles = $repo->command('diff-tree', '--no-commit-id', '--name-only', '-r', 'HEAD..'.$lastCommitHash); + my @testFiles; + foreach my $f (@changedFiles) { + if ($f =~ /.+?\.t$/) { + push(@testFiles, $f); + } + } + print "Found these changed test files in Git history: @testFiles\n" if $verbose > 0; + return {} unless scalar(@testFiles); + return _sortFilesByDir(\@testFiles); +} + +sub _shell { + my (@cmd) = @_; + my $rv = `@cmd`; + my $exitCode = ${^CHILD_ERROR_NATIVE} >> 8; + my $killSignal = ${^CHILD_ERROR_NATIVE} & 127; + my $coreDumpTriggered = ${^CHILD_ERROR_NATIVE} & 128; + warn "Shell command: @cmd\n exited with code '$exitCode'. Killed by signal '$killSignal'.".(($coreDumpTriggered) ? ' Core dumped.' : '')."\n STDOUT: $rv\n" + if $exitCode != 0; + print "@cmd\n$rv\n" if $rv && $verbose > 0; + return $rv; +} + +=head2 _sortFilesByDir + +Sort files in arrays by directory +@RETURNS HASHRef of directory-name keys and test file names + { + 't/db_dependent' => [ + 't/db_dependent/01-test.t', + ], + ... + } +=cut + +sub _sortFilesByDir { + my ($files) = @_; + unless (ref($files) eq 'ARRAY') { + carp "\$files is not an ARRAYRef"; + } + unless (scalar(@$files)) { + carp "\$files is an ampty array?"; + } + + my %dirsWithFiles; + foreach my $f (@$files) { + my $dir = File::Basename::dirname($f); + $dirsWithFiles{$dir} = [] unless $dirsWithFiles{$dir}; + push (@{$dirsWithFiles{$dir}}, $f); + } + return \%dirsWithFiles; +} -- 2.7.4