db/pgbackrest
1
0
Fork 0
mirror of https://github.com/pgbackrest/pgbackrest.git synced 2025-10-30 23:37:45 +02:00
Code Issues Releases Activity

Remove perl critic and coverage.

Browse Source 
No new Perl code is being developed, so these tools are just taking up time and making migrations to newer platforms harder.  There are only a few Perl tests remaining with full coverage so the coverage tool does not warn of loss of coverage in most cases.

Remove both tools and associated libraries.
This commit is contained in:
David Steele
2019-07-05 16:55:17 -04:00
parent fc21013522
commit 9836578520
21 changed files with 19 additions and 532 deletions
Download Patch File Download Diff File Expand all files Collapse all files

7
.travis.yml
View File

@@ -19,7 +19,7 @@ env:
- PGB_CI="doc"
before_install:
- sudo apt-get -qq update && sudo apt-get install libxml-checker-perl libdbd-pg-perl libperl-critic-perl libtemplate-perl libpod-coverage-perl libtest-differences-perl libhtml-parser-perl lintian debhelper txt2man devscripts libjson-perl libio-socket-ssl-perl libxml-libxml-perl libyaml-libyaml-perl python-pip lcov libjson-maybexs-perl libperl-dev
- sudo apt-get -qq update && sudo apt-get install libxml-checker-perl libdbd-pg-perl libyaml-libyaml-perl python-pip lcov libperl-dev
- |
# Install & Configure AWS CLI
pip install --upgrade --user awscli
@@ -28,11 +28,6 @@ before_install:
aws configure set aws_secret_access_key verySecretKey1
aws help --version
aws configure list
- |
# Install Devel::Cover
sudo dpkg -i ${TRAVIS_BUILD_DIR?}/test/package/u14-libdevel-cover-perl_1.29-2_amd64.deb
sudo apt-get -f install
/usr/bin/cover -v
install:
- |

4
doc/lib/BackRestDoc/Common/DocManifest.pm
View File

@@ -272,7 +272,7 @@ sub evaluateIf
my $strIf = $self->variableReplace($oNode->paramGet('if'));
# In this case we really do want to evaluate the contents and not treat it as a literal
$bIf = eval($strIf); ## no critic (BuiltinFunctions::ProhibitStringyEval)
$bIf = eval($strIf);
# Error if the eval failed
if ($@)
@@ -319,7 +319,7 @@ sub variableListParse
if ($oVariable->paramTest('eval', 'y'))
{
# In this case we really do want to evaluate the contents of strValue and not treat it as a literal.
$strValue = eval($strValue); ## no critic (BuiltinFunctions::ProhibitStringyEval)
$strValue = eval($strValue);
if ($@)
{

6
lib/pgBackRest/LibC.pm
View File

@@ -16,8 +16,7 @@ my $rhConstant = pgBackRest::LibCAuto::libcAutoConstant();
foreach my $strConstant (keys(%{$rhConstant}))
{
eval ## no critic (BuiltinFunctions::ProhibitStringyEval, ErrorHandling::RequireCheckingReturnValueOfEval)
"use constant ${strConstant} => '" . $rhConstant->{$strConstant} . "'";
eval "use constant ${strConstant} => '" . $rhConstant->{$strConstant} . "'";
}
# Export functions and constants
@@ -48,8 +47,7 @@ foreach my $strSection (keys(%EXPORT_TAGS))
if ($strPrefix eq 'CFGCMD' || $strPrefix eq 'CFGOPT')
{
eval ## no critic (BuiltinFunctions::ProhibitStringyEval, ErrorHandling::RequireCheckingReturnValueOfEval)
"use constant ${strConstant} => ${iConstantIdx}";
eval "use constant ${strConstant} => ${iConstantIdx}";
}
$strPrefixLast = $strPrefix;

6
src/perl/embed.auto.c
View File

@@ -8178,8 +8178,7 @@ static const EmbeddedModule embeddedModule[] =
"\n"
"foreach my $strConstant (keys(%{$rhConstant}))\n"
"{\n"
"eval\n"
"\"use constant ${strConstant} => '\" . $rhConstant->{$strConstant} . \"'\";\n"
"eval \"use constant ${strConstant} => '\" . $rhConstant->{$strConstant} . \"'\";\n"
"}\n"
"\n\n"
"our %EXPORT_TAGS = %{pgBackRest::LibCAuto::libcAutoExportTag()};\n"
@@ -8208,8 +8207,7 @@ static const EmbeddedModule embeddedModule[] =
"\n"
"if ($strPrefix eq 'CFGCMD' || $strPrefix eq 'CFGOPT')\n"
"{\n"
"eval\n"
"\"use constant ${strConstant} => ${iConstantIdx}\";\n"
"eval \"use constant ${strConstant} => ${iConstantIdx}\";\n"
"}\n"
"\n"
"$strPrefixLast = $strPrefix;\n"

7
test/Vagrantfile vendored
View File

@@ -55,8 +55,7 @@ Vagrant.configure(2) do |config|
#---------------------------------------------------------------------------------------------------------------------------
echo 'Install Perl Modules' && date
apt-get install -y libdbd-pg-perl libio-socket-ssl-perl libxml-libxml-perl libxml-checker-perl libperl-critic-perl \
libdevel-nytprof-perl libyaml-libyaml-perl
apt-get install -y libdbd-pg-perl libxml-checker-perl libyaml-libyaml-perl
#---------------------------------------------------------------------------------------------------------------------------
echo 'Install Build Tools' && date
@@ -73,10 +72,6 @@ Vagrant.configure(2) do |config|
sudo -i -u vagrant aws configure set aws_access_key_id accessKey1
sudo -i -u vagrant aws configure set aws_secret_access_key verySecretKey1
#---------------------------------------------------------------------------------------------------------------------------
echo 'Install Devel::Cover' && date
dpkg -i /backrest/test/package/u18-libdevel-cover-perl_1.29-2_amd64.deb
#---------------------------------------------------------------------------------------------------------------------------
echo 'Install Docker' && date
curl -fsSL https://get.docker.com | sh

49
test/define.yaml
View File

@@ -294,37 +294,22 @@ unit:
- name: ini-perl
total: 10
coverage:
Common/Ini: partial
# ----------------------------------------------------------------------------------------------------------------------------
- name: io-handle-perl
total: 6
coverage:
Common/Io/Handle: full
# ----------------------------------------------------------------------------------------------------------------------------
- name: io-buffered-perl
total: 3
coverage:
Common/Io/Buffered: partial
# ----------------------------------------------------------------------------------------------------------------------------
- name: io-process-perl
total: 3
coverage:
Common/Io/Process: partial
# ----------------------------------------------------------------------------------------------------------------------------
- name: log-perl
total: 1
coverage:
Common/Log: partial
# ********************************************************************************************************************************
- name: postgres
@@ -426,9 +411,6 @@ unit:
- name: helper-perl
total: 3
coverage:
Storage/Helper: full
# ----------------------------------------------------------------------------------------------------------------------------
- name: cifs
total: 1
@@ -486,16 +468,10 @@ unit:
- name: common-minion-perl
total: 1
coverage:
Protocol/Base/Minion: partial
# ----------------------------------------------------------------------------------------------------------------------------
- name: helper-perl
total: 2
coverage:
Protocol/Helper: partial
# ----------------------------------------------------------------------------------------------------------------------------
- name: protocol
total: 8
@@ -538,9 +514,6 @@ unit:
- name: info-archive-perl
total: 4
coverage:
Archive/Info: partial
# ----------------------------------------------------------------------------------------------------------------------------
- name: info-backup
total: 2
@@ -552,9 +525,6 @@ unit:
- name: info-backup-perl
total: 3
coverage:
Backup/Info: partial
# ********************************************************************************************************************************
- name: command
@@ -570,9 +540,6 @@ unit:
- name: archive-common-perl
total: 4
coverage:
Archive/Common: partial
# ----------------------------------------------------------------------------------------------------------------------------
- name: archive-get
total: 5
@@ -587,9 +554,6 @@ unit:
- name: archive-get-perl
total: 1
coverage:
Archive/Get/File: partial
# ----------------------------------------------------------------------------------------------------------------------------
- name: archive-push
total: 4
@@ -680,17 +644,10 @@ unit:
- name: unit-perl
total: 4
coverage:
Backup/Common: full
Backup/Backup: partial
# ----------------------------------------------------------------------------------------------------------------------------
- name: file-unit-perl
total: 2
coverage:
Backup/File: partial
# ********************************************************************************************************************************
- name: manifest
@@ -699,9 +656,6 @@ unit:
- name: all-perl
total: 11
coverage:
Manifest: partial
# ********************************************************************************************************************************
- name: stanza
@@ -710,9 +664,6 @@ unit:
- name: all-perl
total: 9
coverage:
Stanza: full
# **********************************************************************************************************************************
# Integration tests
#

11
test/lib/pgBackRestTest/Common/CiTest.pm
View File

@@ -100,10 +100,8 @@ sub process
$strConfig .=
"\n" .
"before_install:\n" .
" - sudo apt-get -qq update && sudo apt-get install libxml-checker-perl libdbd-pg-perl libperl-critic-perl" .
" libtemplate-perl libpod-coverage-perl libtest-differences-perl libhtml-parser-perl lintian debhelper txt2man" .
" devscripts libjson-perl libio-socket-ssl-perl libxml-libxml-perl libyaml-libyaml-perl python-pip lcov" .
" libjson-maybexs-perl libperl-dev\n" .
" - sudo apt-get -qq update && sudo apt-get install libxml-checker-perl libdbd-pg-perl libyaml-libyaml-perl python-pip" .
" lcov libperl-dev\n" .
" - |\n" .
" # Install & Configure AWS CLI\n" .
" pip install --upgrade --user awscli\n" .
@@ -112,11 +110,6 @@ sub process
" aws configure set aws_secret_access_key verySecretKey1\n" .
" aws help --version\n" .
" aws configure list\n" .
" - |\n" .
" # Install Devel::Cover\n" .
" sudo dpkg -i \${TRAVIS_BUILD_DIR?}/test/package/u14-" . packageDevelCover(VM_ARCH_AMD64) . "\n" .
" sudo apt-get -f install\n" .
' ' . LIB_COVER_EXE . " -v\n" .
"\n" .
"install:\n" .
" - |\n" .

54
test/lib/pgBackRestTest/Common/ContainerTest.pm
View File

@@ -564,7 +564,6 @@ sub containerBuild
$strCopy = undef;
my $strPkgDevelCover = packageDevelCover($oVm->{$strOS}{&VM_ARCH});
my $bPkgDevelCoverBuild = vmCoveragePerl($strOS) && !$oStorageDocker->exists("test/package/${strOS}-${strPkgDevelCover}");
$strScript = sectionHeader() .
"# Create test user\n" .
@@ -577,18 +576,6 @@ sub containerBuild
$strScript .= sectionHeader() .
"# Install pgBackRest package source\n" .
" git clone https://salsa.debian.org/postgresql/pgbackrest.git /root/package-src";
# Build only when a new version has been specified
if ($bPkgDevelCoverBuild)
{
$strScript .= sectionHeader() .
"# Install Devel::Cover package source & build\n" .
" git clone https://salsa.debian.org/perl-team/modules/packages/libdevel-cover-perl.git" .
" /root/libdevel-cover-perl && \\\n" .
" cd /root/libdevel-cover-perl && \\\n" .
" git checkout debian/" . LIB_COVER_VERSION . " && \\\n" .
" debuild -i -us -uc -b";
}
}
else
{
@@ -607,23 +594,6 @@ sub containerBuild
containerWrite($oStorageDocker, $strTempPath, $strOS, 'Build', $strImageParent, $strImage, $strCopy, $strScript, $bVmForce);
# Copy Devel::Cover to host so it can be installed in other containers (if it doesn't already exist)
if ($bPkgDevelCoverBuild)
{
executeTest('docker rm -f test-build', {bSuppressError => true});
executeTest(
"docker run -itd -h test-build --name=test-build" .
" -v ${strTempPath}:${strTempPath} " . containerRepo() . ":${strOS}-build",
{bSuppressStdErr => true});
executeTest(
"docker exec -i test-build " .
"bash -c 'cp /root/${strPkgDevelCover} ${strTempPath}/${strOS}-${strPkgDevelCover}'");
executeTest('docker rm -f test-build');
$oStorageDocker->move(
"test/.vagrant/docker/${strOS}-${strPkgDevelCover}", "test/package/${strOS}-${strPkgDevelCover}");
}
# Test image
########################################################################################################################
if (!$bDeprecated)
@@ -631,28 +601,8 @@ sub containerBuild
$strImageParent = containerRepo() . ":${strOS}-base";
$strImage = "${strOS}-test";
if (vmCoveragePerl($strOS))
{
$oStorageDocker->copy(
"test/package/${strOS}-${strPkgDevelCover}", "test/.vagrant/docker/${strOS}-${strPkgDevelCover}");
$strCopy =
"# Copy Devel::Cover\n" .
"COPY ${strOS}-${strPkgDevelCover} /tmp/${strPkgDevelCover}";
$strScript = sectionHeader() .
"# Install packages\n" .
" apt-get install -y libjson-maybexs-perl";
$strScript .= sectionHeader() .
"# Install Devel::Cover\n" .
" dpkg -i /tmp/${strPkgDevelCover}";
}
else
{
$strCopy = undef;
$strScript = '';
}
$strCopy = undef;
$strScript = '';
#---------------------------------------------------------------------------------------------------------------------------
$strScript .= sectionHeader() .

4
test/lib/pgBackRestTest/Common/JobTest.pm
View File

@@ -261,9 +261,7 @@ sub run
{
$strCommand =
($self->{oTest}->{&TEST_CONTAINER} ? 'docker exec -i -u ' . TEST_USER . " ${strImage} " : '') .
testRunExe(
vmCoverageC($self->{oTest}->{&TEST_VM}), undef, abs_path($0), dirname($self->{strCoveragePath}),
$self->{strBackRestBase}, $self->{oTest}->{&TEST_MODULE}, $self->{oTest}->{&TEST_NAME}) .
abs_path($0) .
" --test-path=${strVmTestPath}" .
" --vm=$self->{oTest}->{&TEST_VM}" .
" --vm-id=$self->{iVmIdx}" .

66
test/lib/pgBackRestTest/Common/RunTest.pm
View File

@@ -159,9 +159,7 @@ sub process
$oStorage = new pgBackRest::Storage::Storage(STORAGE_LOCAL, {strPath => $self->testPath()});
# Generate backrest exe
$self->{strBackRestExe} = testRunExe(
$self->coverage(), $self->{strBackRestExeC}, $self->{strBackRestExeHelper}, dirname($self->testPath()), $self->basePath(),
$self->module(), $self->moduleTest(), true);
$self->{strBackRestExe} = defined($self->{strBackRestExeC}) ? $self->{strBackRestExeC} : $self->{strBackRestExeHelper};
projectBinSet($self->{strBackRestExe});
@@ -508,8 +506,7 @@ sub testRun
'pgBackRestTest::Module::' . testRunName($strModule) . '::' . testRunName($strModule) . testRunName($strModuleTest) .
'Test';
$oTestRun = eval( ## no critic (BuiltinFunctions::ProhibitStringyEval)
"require ${strModuleName}; ${strModuleName}->import(); return new ${strModuleName}();")
$oTestRun = eval("require ${strModuleName}; ${strModuleName}->import(); return new ${strModuleName}();")
or do {confess $EVAL_ERROR};
# Return from function and log return values if any
@@ -532,64 +529,6 @@ sub testRunGet
push @EXPORT, qw(testRunGet);
####################################################################################################################################
# Generate test executable
####################################################################################################################################
sub testRunExe
{
my $bCoverage = shift;
my $strExeC = shift;
my $strExeHelper = shift;
my $strCoveragePath = shift;
my $strBackRestBasePath = shift;
my $strModule = shift;
my $strTest = shift;
my $bLog = shift;
my $strExe = defined($strExeC) ? $strExeC : undef;
my $strPerlModule;
if ($bCoverage)
{
# Limit Perl modules tested to what is defined in the test coverage (if it exists)
my $hTestCoverage = (testDefModuleTest($strModule, $strTest))->{&TESTDEF_COVERAGE};
my $strPerlModuleLog;
if (defined($hTestCoverage))
{
foreach my $strCoverageModule (sort(keys(%{$hTestCoverage})))
{
$strPerlModule .= ',.*/' . $strCoverageModule . '\.p.$';
$strPerlModuleLog .= (defined($strPerlModuleLog) ? ', ' : '') . $strCoverageModule;
}
}
# Build the exe
if (defined($strPerlModule))
{
$strExe .=
(defined($strExeC) ? ' --perl-option=' : 'perl ') .
"-MDevel::Cover=-silent,1,-dir,${strCoveragePath},-select${strPerlModule},+inc" .
",${strBackRestBasePath},-coverage,statement,branch,condition,path,subroutine" .
(defined($strExeC) ? '' : " ${strExeHelper}");
if (defined($bLog) && $bLog)
{
&log(INFO, " coverage: ${strPerlModuleLog}");
}
}
}
if (!defined($strExeC) && !defined($strPerlModule))
{
$strExe = $strExeHelper;
}
return $strExe;
}
push(@EXPORT, qw(testRunExe));
####################################################################################################################################
# storageTest - get the storage for the current test
####################################################################################################################################
@@ -607,7 +546,6 @@ sub archBits {return vmArchBits(shift->{strVm})}
sub backrestExe {return shift->{strBackRestExe}}
sub backrestUser {return shift->{strBackRestUser}}
sub basePath {return shift->{strBasePath}}
sub coverage {vmCoveragePerl(shift->{strVm})}
sub dataPath {return shift->basePath() . '/test/data'}
sub doCleanup {return shift->{bCleanup}}
sub doExpect {return shift->{bExpect}}

26
test/lib/pgBackRestTest/Common/VmTest.pm
View File

@@ -31,8 +31,6 @@ use constant VM_CONTROL_MASTER => 'control-
push @EXPORT, qw(VM_CONTROL_MASTER);
# Will coverage testing be run for C?
use constant VMDEF_COVERAGE_C => 'coverage-c';
# Will coverage testing be run for Perl?
use constant VMDEF_COVERAGE_PERL => 'coverage-perl';
use constant VM_DEPRECATED => 'deprecated';
push @EXPORT, qw(VM_DEPRECATED);
use constant VM_IMAGE => 'image';
@@ -342,7 +340,6 @@ my $oyVm =
&VM_IMAGE => 'ubuntu:18.04',
&VM_ARCH => VM_ARCH_AMD64,
&VMDEF_COVERAGE_C => true,
&VMDEF_COVERAGE_PERL => true,
&VMDEF_LINT_C => true,
&VMDEF_PGSQL_BIN => '/usr/lib/postgresql/{[version]}/bin',
&VMDEF_PERL_ARCH_PATH => '/usr/local/lib/x86_64-linux-gnu/perl/5.26.1',
@@ -384,7 +381,6 @@ foreach my $strVm (sort(keys(%{$oyVm})))
foreach my $strPgVersion (versionSupport())
{
my $strVmPgVersionRun;
my $bVmCoveragePerl = false;
my $bVmCoverageC = false;
foreach my $strVm (VM_LIST)
@@ -394,11 +390,6 @@ foreach my $strPgVersion (versionSupport())
$bVmCoverageC = true;
}
if (vmCoveragePerl($strVm))
{
$bVmCoveragePerl = true;
}
foreach my $strVmPgVersion (@{$oyVm->{$strVm}{&VM_DB_TEST}})
{
if ($strPgVersion eq $strVmPgVersion)
@@ -420,11 +411,6 @@ foreach my $strPgVersion (versionSupport())
confess &log(ASSERT, "C coverage ${strErrorSuffix}");
}
if (!$bVmCoveragePerl)
{
confess &log(ASSERT, "Perl coverage ${strErrorSuffix}");
}
if (!defined($strVmPgVersionRun))
{
confess &log(ASSERT, "PostgreSQL ${strPgVersion} ${strErrorSuffix}");
@@ -466,18 +452,6 @@ sub vmCoverageC
push @EXPORT, qw(vmCoverageC);
####################################################################################################################################
# vmCoveragePerl
####################################################################################################################################
sub vmCoveragePerl
{
my $strVm = shift;
return $oyVm->{$strVm}{&VMDEF_COVERAGE_PERL} ? true : false;
}
push @EXPORT, qw(vmCoveragePerl);
####################################################################################################################################
# vmLintC
####################################################################################################################################

2
test/lib/pgBackRestTest/Env/Host/HostDbSyntheticTest.pm
View File

@@ -245,7 +245,7 @@ sub manifestFileCreate
if (!$bChecksumPage && $strChecksumPageError ne '0')
{
my @iyChecksumPageError = eval($strChecksumPageError); ## no critic (BuiltinFunctions::ProhibitStringyEval)
my @iyChecksumPageError = eval($strChecksumPageError);
$oManifestRef->{&MANIFEST_SECTION_TARGET_FILE}{$strManifestKey}{&MANIFEST_SUBKEY_CHECKSUM_PAGE_ERROR} =
\@iyChecksumPageError;

186
test/lint/perlcritic.policy
View File

@@ -1,186 +0,0 @@
# Main Perl Critic Policy Applied to Entire Code Base
#-----------------------------------------------------------------------------------------------------------------------------------
# Important policies that should always be checked
#-----------------------------------------------------------------------------------------------------------------------------------
[TestingAndDebugging::RequireUseStrict]
severity = 5
[TestingAndDebugging::RequireUseWarnings]
severity = 5
# Permanent Exceptions
#-----------------------------------------------------------------------------------------------------------------------------------
# Requires all local variables to be all lower/upper case -- can't see how this is a good thing.
[-NamingConventions::Capitalization]
# Requires @_ to be immediately unpacked but won't work with param logging scheme.
[-Subroutines::RequireArgUnpacking]
# Requires all exports to be configurable by caller. This is fine for independent libraries but
# overly burdensome for modules integrated as part of an application. Maybe apply to certain modules
# that are also used by doc and test programs?
[-Modules::ProhibitAutomaticExportation]
# Requires built-in functions to not have parens, but in this project it is preferred to wrap all
# function calls in parens for consistency.
[-CodeLayout::ProhibitParensWithBuiltins]
# Requires module version vars. Probably not practical for built-in modules.
[-Modules::RequireVersionVar]
# Requires extended formatting for all regexps. Seems overly burdensome, or at least something to look
# at a lot further down the road.
[-RegularExpressions::RequireExtendedFormatting]
# Requires Unicode safe expressions. May be worth looking at sometime.
[-RegularExpressions::ProhibitEnumeratedClasses]
# S2 - Requires List::MoreUtils instead of boolean grep. Not worth it to load another module.
[-BuiltinFunctions::ProhibitBooleanGrep]
# Provisional Exceptions for Test & Documentation Code
#-----------------------------------------------------------------------------------------------------------------------------------
# S2 - Requires complete POD sections but these are being removed anyway in favor of Config.pm.
[-Documentation::RequirePodSections]
[-Documentation::RequirePodAtEnd]
# S3 - Requires regexps to be below a certain length. Seems burdensome.
[-RegularExpressions::ProhibitComplexRegexes]
# To Be Fixed or Evaluated
#
# Natural ordering here indicates the order in which they should be addressed.
#-----------------------------------------------------------------------------------------------------------------------------------
# S2 - Requires all long numbers to have thousand separators. Probably a good idea bit need to change a fair amount of code.
[-ValuesAndExpressions::RequireNumberSeparators]
# S4 - Requires parens when logical and bitwise booleans are mixed.
[-ValuesAndExpressions::ProhibitMixedBooleanOperators]
# S4 - Requires that sub names not overlap with built-ins - a bummer for object members.
[-Subroutines::ProhibitBuiltinHomonyms]
# S4 - Requires block form of grep for readability. Needs to be fixed in about 15 places.
[-BuiltinFunctions::RequireBlockGrep]
# S4 - Requires modification of certain vars (e.g. $SIG) to have local scope. Needs to be fixed in about 20 places.
[-Variables::RequireLocalizedPunctuationVars]
# S4 - Requires close() to be called soon after open but seems arbitrary.
[-InputOutput::RequireBriefOpen]
# S1 - Requires reverse keyword for reverse sorts instead of block. May not be able to since $a $b are passed as a parameter.
[-BuiltinFunctions::ProhibitReverseSortBlock]
# S3 - Requires use of Carp instead of die or warn. Doesn't seem useful.
[-ErrorHandling::RequireCarping]
# S3 - Requires use of local vars in packages. Can't use as it prohibits use of $DBI::errstr.
[-Variables::ProhibitPackageVars]
# S3 - Requires that certain operators not be mixed.
[-ValuesAndExpressions::ProhibitMismatchedOperators]
# S2 - Requires use of if instead of unless.
[-ControlStructures::ProhibitUnlessBlocks]
# S1 - Requires true literals to use single quotes.
[-ValuesAndExpressions::ProhibitInterpolationOfLiterals]
# S2 - Requires split expressions to be regexp for clarity.
[-BuiltinFunctions::ProhibitStringySplit]
# S4 - Requires use of Readonly instead of const. Has performance and syntax advantages.
[-ValuesAndExpressions::ProhibitConstantPragma]
# S2 - Requires all numbers to be defined as constants
[-ValuesAndExpressions::ProhibitMagicNumbers]
# S4 - Requires all subs to have a return, even if there is not value to return.
[-Subroutines::RequireFinalReturn]
# S4 - Requires new to be called as Object->new().
[-Objects::ProhibitIndirectSyntax]
# S2 - Requires that & not be used in functions calls. Currently this is used a lot for &log() calls.
[-Subroutines::ProhibitAmpersandSigils]
# S2 - Requires use of eq instead of regexp when possible.
[-RegularExpressions::ProhibitFixedStringMatches]
# S2 - Requires that sigils be separated by braces, eg %$var becomes %{$var}.
[-References::ProhibitDoubleSigils]
# S2 - Requires use English instead a puctuation vars such as $!.
[-Variables::ProhibitPunctuationVars]
# S3 - Requires nested if/else have limited depth and recommends using given/when instead.
[-ControlStructures::ProhibitCascadingIfElse]
# S2 - Requires empty strings to be represented with qw{}.
[-ValuesAndExpressions::ProhibitEmptyQuotes]
# S2 - Requires non letter and number strings to be represented with something like qw{/}.
[-ValuesAndExpressions::ProhibitNoisyQuotes]
# S2 - Requires expanded matching for . in regular expressions.
[-RegularExpressions::RequireDotMatchAnything]
# S2 - Requires sed-style boundary matching. May not be appropriate for reg exps in this project, though.
[-RegularExpressions::RequireLineBoundaryMatching]
# S1 - Requires use of Perl::Tidy.
[-CodeLayout::RequireTidyCode]
# S2 - Requires use of Perl syntax for simple loops, e.g. for (0..$max).
[-ControlStructures::ProhibitCStyleForLoops]
# S2 - Require standard if structures rather than postfix for readability.
[-ControlStructures::ProhibitPostfixControls]
# S3 - Requires code have a McCabe score of no more than 20 but is configurable.
[-Subroutines::ProhibitExcessComplexity]
[-Modules::ProhibitExcessMainComplexity]
# S3 - Requires low level of code nesting (may require a lot of refactoring).
[-ControlStructures::ProhibitDeepNests]
# S3 - Requires subs to have <= 6 args but is configurable.
[-Subroutines::ProhibitManyArgs]
# S3 - Requires arbitrary unambigious names but is configurable.
[-NamingConventions::ProhibitAmbiguousNames]
# S3 - Requires that var names never be resused in a sub, not sure about this one.
[-Variables::ProhibitReusedNames]
# S3 - Requires non-capturing groups in regexp, primarily a performance optimization.
[-RegularExpressions::ProhibitUnusedCapture]
# S1 - Requires trailing commas on all lists.
[-CodeLayout::RequireTrailingCommas]
# S2 - Requires chained calls be less than four.
[-ValuesAndExpressions::ProhibitLongChainsOfMethodCalls]
# S2 - Requires check for success of close() function.
[-InputOutput::RequireCheckedClose]
# S1 - Requires use Fatal or autodie with syscalls.
[-InputOutput::RequireCheckedSyscalls]
# S1 - Requires less abiguity for metacharacters in strings.
[-ValuesAndExpressions::RequireInterpolationOfMetachars]
# S4 - Requires character classes to reduce escapes in regexps.
[-RegularExpressions::ProhibitEscapedMetacharacters]
# S1 - Require character classes rather than single character alternation.
[-RegularExpressions::ProhibitSingleCharAlternation]
# S2 - Require qw{} syntax for quoted string lists
[-CodeLayout::ProhibitQuotedWordLists]

BIN
test/package/d8-libdevel-cover-perl_1.23-2_amd64.deb
View File

Binary file not shown.

BIN
test/package/d9-libdevel-cover-perl_1.23-2_amd64.deb
View File

Binary file not shown.

BIN
test/package/u12-libdevel-cover-perl_1.23-2_amd64.deb
View File

Binary file not shown.

BIN
test/package/u14-libdevel-cover-perl_1.23-2_amd64.deb
View File

Binary file not shown.

BIN
test/package/u14-libdevel-cover-perl_1.29-2_amd64.deb
View File

Binary file not shown.

BIN
test/package/u16-libdevel-cover-perl_1.23-2_amd64.deb
View File

Binary file not shown.

BIN
test/package/u18-libdevel-cover-perl_1.29-2_amd64.deb
View File

Binary file not shown.

123
test/test.pl
View File

@@ -342,10 +342,6 @@ eval
{
confess &log(ERROR, "select a single Debian-based VM for coverage testing");
}
elsif (!vmCoveragePerl($strVm))
{
confess &log(ERROR, "only Debian-based VMs can be used for coverage testing");
}
}
# If VM is not defined then set it to all
@@ -540,7 +536,7 @@ eval
# Auto-generate Perl code
#-----------------------------------------------------------------------------------------------------------------------
use lib dirname(dirname($0)) . '/libc/build/lib';
use pgBackRestLibC::Build; ## no critic (Modules::ProhibitConditionalUseStatements)
use pgBackRestLibC::Build;
if (!$bSmart || grep(/^(build|libc\/build)\//, @stryModifiedList))
{
@@ -737,7 +733,7 @@ eval
$oStorageTest->pathCreate($strCoveragePath, {strMode => '0770', bIgnoreExists => true, bCreateParent => true});
# Remove old coverage dirs -- do it this way so the dirs stay open in finder/explorer, etc.
executeTest("rm -rf ${strBackRestBase}/test/coverage/c/* ${strBackRestBase}/test/coverage/perl/*");
executeTest("rm -rf ${strBackRestBase}/test/coverage/c/*");
# Overwrite the C coverage report so it will load but not show old coverage
$oStorageTest->pathCreate("${strBackRestBase}/test/coverage", {strMode => '0770', bIgnoreExists => true});
@@ -1229,21 +1225,6 @@ eval
#---------------------------------------------------------------------------------------------------------------------------
if (!$bDryRun)
{
# Run Perl critic
if (!$bNoLint && !$bBuildOnly)
{
my $strBasePath = dirname(dirname(abs_path($0)));
&log(INFO, "Performing static code analysis using perlcritic");
executeTest('perlcritic --quiet --verbose=8 --brutal --top=10' .
' --verbose "[%p] %f: %m at line %l, column %c. %e. (Severity: %s)\n"' .
" \"--profile=${strBasePath}/test/lint/perlcritic.policy\"" .
" ${strBasePath}/lib/*" .
" ${strBasePath}/test/test.pl ${strBasePath}/test/lib/*" .
" ${strBasePath}/doc/doc.pl ${strBasePath}/doc/lib/*");
}
logFileSet($oStorageTest, cwd() . "/test");
}
@@ -1346,7 +1327,7 @@ eval
#---------------------------------------------------------------------------------------------------------------------------
my $iUncoveredCodeModuleTotal = 0;
if ((vmCoverageC($strVm) || vmCoveragePerl($strVm)) && !$bNoCoverage && !$bDryRun && $iTestFail == 0)
if (vmCoverageC($strVm) && !$bNoCoverage && !$bDryRun && $iTestFail == 0)
{
# Determine which modules were covered (only check coverage if all tests were successful)
#-----------------------------------------------------------------------------------------------------------------------
@@ -1403,104 +1384,6 @@ eval
&log(INFO, 'no code modules had all tests run required for coverage');
}
# Generate Perl coverage report
#-----------------------------------------------------------------------------------------------------------------------
if (vmCoveragePerl($strVm))
{
&log(INFO, 'writing Perl coverage report');
executeTest("cp -rp ${strCoveragePath} ${strCoveragePath}_temp");
executeTest(
"cd ${strCoveragePath}_temp && " .
LIB_COVER_EXE . " -report json -outputdir ${strBackRestBase}/test/coverage/perl ${strCoveragePath}_temp",
{bSuppressStdErr => true});
executeTest("sudo rm -rf ${strCoveragePath}_temp");
executeTest("sudo cp -rp ${strCoveragePath} ${strCoveragePath}_temp");
executeTest(
"cd ${strCoveragePath}_temp && " .
LIB_COVER_EXE . " -outputdir ${strBackRestBase}/test/coverage/perl ${strCoveragePath}_temp",
{bSuppressStdErr => true});
executeTest("sudo rm -rf ${strCoveragePath}_temp");
# Load the results of coverage testing from JSON
my $oJSON = JSON::PP->new()->allow_nonref();
my $hCoverageResult = $oJSON->decode(${$oStorageBackRest->get('test/coverage/perl/cover.json')});
foreach my $strCodeModule (sort(keys(%{$hCoverageActual})))
{
# If the first char of the module is lower case then it's a c module
if (substr($strCodeModule, 0, 1) eq lc(substr($strCodeModule, 0, 1)))
{
next;
}
# Create code module path -- where the file is located on disk
my $strCodeModulePath = "${strBackRestBase}/lib/" . PROJECT_NAME . "/${strCodeModule}.pm";
# Get summary results
my $hCoverageResultAll = $hCoverageResult->{'summary'}{$strCodeModulePath}{total};
# Try an extra / if the module is not found
if (!defined($hCoverageResultAll))
{
$strCodeModulePath = "/${strCodeModulePath}";
$hCoverageResultAll = $hCoverageResult->{'summary'}{$strCodeModulePath}{total};
}
# If module is marked as having no code
if ($hCoverageActual->{$strCodeModule} eq TESTDEF_COVERAGE_NOCODE)
{
# Error if it really does have coverage
if ($hCoverageResultAll)
{
confess &log(ERROR, "perl module ${strCodeModule} is marked 'no code' but has code");
}
# Skip to next module
next;
}
if (!defined($hCoverageResultAll))
{
confess &log(ERROR, "unable to find coverage results for ${strCodeModule}");
}
# Check that all code has been covered
my $iCoverageTotal = $hCoverageResultAll->{total};
my $iCoverageUncoverable = coalesce($hCoverageResultAll->{uncoverable}, 0);
my $iCoverageCovered = coalesce($hCoverageResultAll->{covered}, 0);
if ($hCoverageActual->{$strCodeModule} eq TESTDEF_COVERAGE_FULL)
{
my $iUncoveredLines = $iCoverageTotal - $iCoverageCovered - $iCoverageUncoverable;
if ($iUncoveredLines != 0)
{
&log(ERROR, "perl module ${strCodeModule} is not fully covered");
$iUncoveredCodeModuleTotal++;
&log(ERROR, ('-' x 80));
executeTest(
"/usr/bin/cover -report text ${strCoveragePath} --select ${strBackRestBase}/lib/" .
PROJECT_NAME . "/${strCodeModule}.pm",
{bShowOutputAsync => true});
&log(ERROR, ('-' x 80));
}
}
# Else test how much partial coverage there was
elsif ($hCoverageActual->{$strCodeModule} eq TESTDEF_COVERAGE_PARTIAL)
{
my $iCoveragePercent = int(($iCoverageCovered + $iCoverageUncoverable) * 100 / $iCoverageTotal);
if ($iCoveragePercent == 100)
{
&log(ERROR, "perl module ${strCodeModule} has 100% coverage but is not marked fully covered");
$iUncoveredCodeModuleTotal++;
}
}
}
}
# Generate C coverage report
#---------------------------------------------------------------------------------------------------------------------------
if (vmCoverageC($strVm))