1
0
mirror of https://github.com/pgbackrest/pgbackrest.git synced 2024-12-14 10:13:05 +02:00
pgbackrest/test/lib/pgBackRestTest/Common/RunTest.pm
David Steele 801e2a5a2c Rename PGBACKREST/BACKREST constants to PROJECT.
This brings consistency between the C and Perl constants and allows for easier code reuse.
2018-11-24 19:05:03 -05:00

629 lines
21 KiB
Perl

####################################################################################################################################
# RunTest.pm - All tests are inherited from this object
####################################################################################################################################
package pgBackRestTest::Common::RunTest;
####################################################################################################################################
# Perl includes
####################################################################################################################################
use strict;
use warnings FATAL => qw(all);
use Carp qw(confess);
use English '-no_match_vars';
use Exporter qw(import);
our @EXPORT = qw();
use File::Basename qw(dirname);
use pgBackRest::Common::Exception;
use pgBackRest::Common::Log;
use pgBackRest::Common::String;
use pgBackRest::Common::Wait;
use pgBackRest::Storage::Posix::Driver;
use pgBackRest::Storage::Local;
use pgBackRest::Version;
use pgBackRestTest::Common::DefineTest;
use pgBackRestTest::Common::ExecuteTest;
use pgBackRestTest::Common::LogTest;
use pgBackRestTest::Common::VmTest;
####################################################################################################################################
# Constant to use when bogus data is required
####################################################################################################################################
use constant BOGUS => 'bogus';
push @EXPORT, qw(BOGUS);
####################################################################################################################################
# The current test run that is executung. Only a single run should ever occur in a process to prevent various cleanup issues from
# affecting the next run. Of course multiple subtests can be executed in a single run.
####################################################################################################################################
my $oTestRun;
my $oStorage;
####################################################################################################################################
# new
####################################################################################################################################
sub new
{
my $class = shift; # Class name
# Create the class hash
my $self = {};
bless $self, $class;
# Assign function parameters, defaults, and log debug info
my ($strOperation) = logDebugParam(__PACKAGE__ . '->new');
# Initialize run counter
$self->{iRun} = 0;
# Return from function and log return values if any
return logDebugReturn
(
$strOperation,
{name => 'self', value => $self, trace => true}
);
}
####################################################################################################################################
# initModule
#
# Empty init sub in case the ancestor class does not delare one.
####################################################################################################################################
sub initModule {}
####################################################################################################################################
# initTest
#
# Empty init sub in case the ancestor class does not delare one.
####################################################################################################################################
sub initTest {}
####################################################################################################################################
# cleanTest
#
# Delete all files in test directory.
####################################################################################################################################
sub cleanTest
{
my $self = shift;
executeTest('sudo rm -rf ' . $self->testPath() . '/*');
}
####################################################################################################################################
# cleanModule
#
# Empty final sub in case the ancestor class does not delare one.
####################################################################################################################################
sub cleanModule {}
####################################################################################################################################
# process
####################################################################################################################################
sub process
{
my $self = shift;
# Assign function parameters, defaults, and log debug info
(
my $strOperation,
$self->{strVm},
$self->{iVmId},
$self->{strBasePath},
$self->{strTestPath},
$self->{strBackRestExeC},
$self->{strBackRestExeHelper},
$self->{strPgBinPath},
$self->{strPgVersion},
$self->{strModule},
$self->{strModuleTest},
$self->{iyModuleTestRun},
$self->{bOutput},
$self->{bDryRun},
$self->{bCleanup},
$self->{bLogForce},
$self->{strPgUser},
$self->{strBackRestUser},
$self->{strGroup},
) =
logDebugParam
(
__PACKAGE__ . '->process', \@_,
{name => 'strVm'},
{name => 'iVmId'},
{name => 'strBasePath'},
{name => 'strTestPath'},
{name => 'strBackRestExeC'},
{name => 'strBackRestExeHelper'},
{name => 'strPgBinPath', required => false},
{name => 'strPgVersion', required => false},
{name => 'strModule'},
{name => 'strModuleTest'},
{name => 'iModuleTestRun', required => false},
{name => 'bOutput'},
{name => 'bDryRun'},
{name => 'bCleanup'},
{name => 'bLogForce'},
{name => 'strPgUser'},
{name => 'strBackRestUser'},
{name => 'strGroup'},
);
# Init will only be run on first test, clean/init on subsequent tests
$self->{bFirstTest} = true;
# Initialize test storage
$oStorage = new pgBackRest::Storage::Local($self->testPath(), new pgBackRest::Storage::Posix::Driver());
# Generate backrest exe
$self->{strBackRestExe} = testRunExe(
$self->coverage(), $self->{strBackRestExeC}, $self->{strBackRestExeHelper}, dirname($self->testPath()), $self->basePath(),
$self->module(), $self->moduleTest(), true);
projectBinSet($self->{strBackRestExe});
# Init, run, and end the test(s)
$self->initModule();
$self->run();
$self->end();
$self->cleanModule();
# Make sure the correct number of tests ran
my $hModuleTest = testDefModuleTest($self->{strModule}, $self->{strModuleTest});
if ($hModuleTest->{&TESTDEF_TOTAL} != $self->runCurrent())
{
confess &log(ASSERT, "expected $hModuleTest->{&TESTDEF_TOTAL} tests to run but $self->{iRun} ran");
}
# Return from function and log return values if any
return logDebugReturn
(
$strOperation,
{name => 'self', value => $self, trace => true}
);
}
####################################################################################################################################
# begin
####################################################################################################################################
sub begin
{
my $self = shift;
# Assign function parameters, defaults, and log debug info
my
(
$strOperation,
$strDescription,
$bExpect,
) =
logDebugParam
(
__PACKAGE__ . '->begin', \@_,
{name => 'strDescription'},
{name => 'bExpect', required => false},
);
# Save the previous expect log
$self->end();
# If bExpect is defined then it is an override of the default
$self->{bExpect} = false;
if ($self->vm() eq VM_EXPECT)
{
if (defined($bExpect))
{
$self->{bExpect} = $bExpect;
}
# Else get the default expect setting
else
{
$self->{bExpect} = (testDefModuleTest($self->{strModule}, $self->{strModuleTest}))->{&TESTDEF_EXPECT};
}
}
# Increment the run counter;
$self->{iRun}++;
# Return if this test should not be run
if (@{$self->{iyModuleTestRun}} != 0 && !grep(/^$self->{iRun}$/i, @{$self->{iyModuleTestRun}}))
{
return false;
}
# Output information about test to run
&log(INFO, 'run ' . sprintf('%03d', $self->runCurrent()) . ' - ' . $strDescription);
if ($self->isDryRun())
{
return false;
}
# Create an ExpectTest object
if ($self->doExpect())
{
$self->{oExpect} = new pgBackRestTest::Common::LogTest(
$self->module(), $self->moduleTest(), $self->runCurrent(), $self->doLogForce(), $strDescription,
$self->{strBackRestExe}, $self->pgBinPath(), $self->testPath());
&log(INFO, ' expect log: ' . $self->{oExpect}->{strFileName});
}
if (!$self->{bFirstTest})
{
$self->cleanTest();
}
$self->initTest();
$self->{bFirstTest} = false;
return true;
}
####################################################################################################################################
# end
####################################################################################################################################
sub end
{
my $self = shift;
# Save the previous test log
if (defined($self->expect()))
{
$self->expect()->logWrite($self->basePath(), $self->testPath());
delete($self->{oExpect});
}
}
####################################################################################################################################
# testResult
####################################################################################################################################
sub testResult
{
my $self = shift;
# Assign function parameters, defaults, and log debug info
my
(
$strOperation,
$fnSub,
$strExpected,
$strDescription,
$iWaitSeconds,
$strLogExpect,
$strLogLevel,
) =
logDebugParam
(
__PACKAGE__ . '::testResult', \@_,
{name => 'fnSub', trace => true},
{name => 'strExpected', required => false, trace => true},
{name => 'strDescription', trace => true},
{name => 'iWaitSeconds', optional => true, default => 0, trace => true},
{name => 'strLogExpect', optional => true, trace => true},
{name => 'strLogLevel', optional => true, default => WARN, trace => true},
);
&log(INFO, ' ' . $strDescription);
my $strActual;
my $bWarnValid = true;
my $oWait = waitInit($iWaitSeconds);
my $bDone = false;
# Save the current log levels and set the file level to strLogLevel, console to off, and timestamp false
my ($strLogLevelFile, $strLogLevelConsole, $strLogLevelStdErr, $bLogTimestamp) = logLevel();
logLevelSet($strLogLevel, OFF, undef, false);
# Clear the cache for this test
logFileCacheClear();
my @stryResult;
do
{
eval
{
@stryResult = ref($fnSub) eq 'CODE' ? $fnSub->() : $fnSub;
if (@stryResult <= 1)
{
$strActual = ${logDebugBuild($stryResult[0])};
}
else
{
$strActual = ${logDebugBuild(\@stryResult)};
}
# Restore the log level
logLevelSet($strLogLevelFile, $strLogLevelConsole, $strLogLevelStdErr, $bLogTimestamp);
return true;
}
or do
{
# Restore the log level
logLevelSet($strLogLevelFile, $strLogLevelConsole, $strLogLevelStdErr, $bLogTimestamp);
if (!isException(\$EVAL_ERROR))
{
confess "unexpected standard Perl exception" . (defined($EVAL_ERROR) ? ": ${EVAL_ERROR}" : '');
}
confess &logException($EVAL_ERROR);
};
if ($strActual ne (defined($strExpected) ? $strExpected : "[undef]"))
{
if (!waitMore($oWait))
{
confess
"expected:\n" . (defined($strExpected) ? "\"${strExpected}\"" : '[undef]') .
"\nbut actual was:\n" . (defined($strActual) ? "\"${strActual}\"" : '[undef]');
}
}
else
{
$bDone = true;
}
} while (!$bDone);
# If we get here then test any warning message
if (defined($strLogExpect))
{
my $strLogMessage = trim(logFileCache());
# Strip leading Process marker and whitespace from each line
$strLogMessage =~ s/^(P[0-9]{2})*\s+//mg;
# If the expected message does not exactly match the logged message or is not at least contained in it, then error
if (!($strLogMessage eq $strLogExpect || $strLogMessage =~ $strLogExpect))
{
confess &log(ERROR,
"the log message:\n$strLogMessage\ndoes not match or does not contain the expected message:\n" .
$strLogExpect);
}
}
# Return from function and log return values if any
return logDebugReturn
(
$strOperation,
{name => 'result', value => \@stryResult, trace => true}
);
}
####################################################################################################################################
# testException
####################################################################################################################################
sub testException
{
my $self = shift;
my $fnSub = shift;
my $iCodeExpected = shift;
my $strMessageExpected = shift;
# Output first line of the error message
&log(INFO,
" [${iCodeExpected}] " . (defined($strMessageExpected) ? (split('\n', $strMessageExpected))[0] : 'undef error message'));
my $bError = false;
my $strError =
"exception ${iCodeExpected}, " . (defined($strMessageExpected) ? "'${strMessageExpected}'" : '[UNDEF]') . " was expected";
eval
{
logDisable();
$fnSub->();
logEnable();
return true;
}
or do
{
logEnable();
if (!isException(\$EVAL_ERROR))
{
confess "${strError} but actual was standard Perl exception" . (defined($EVAL_ERROR) ? ": ${EVAL_ERROR}" : '');
}
if (!($EVAL_ERROR->code() == $iCodeExpected &&
(!defined($strMessageExpected) && !defined($EVAL_ERROR->message()) ||
(defined($strMessageExpected) && defined($EVAL_ERROR->message()) &&
($EVAL_ERROR->message() eq $strMessageExpected || $EVAL_ERROR->message() =~ "^${strMessageExpected}" ||
$EVAL_ERROR->message() =~ "^${strMessageExpected} at ")))))
{
confess
"${strError} but actual was " . $EVAL_ERROR->code() . ', ' .
(defined($EVAL_ERROR->message()) ? qw{'} . $EVAL_ERROR->message() . qw{'} : '[UNDEF]');
}
$bError = true;
};
if (!$bError)
{
confess "${strError} but no exception was thrown";
}
}
####################################################################################################################################
# testRunName
#
# Create module/test names by upper-casing the first letter and then inserting capitals after each -.
####################################################################################################################################
sub testRunName
{
my $strName = shift;
my $bInitCapFirst = shift;
$bInitCapFirst = defined($bInitCapFirst) ? $bInitCapFirst : true;
my $bFirst = true;
my @stryName = split('\-', $strName);
$strName = undef;
foreach my $strPart (@stryName)
{
$strName .= ($bFirst && $bInitCapFirst) || !$bFirst ? ucfirst($strPart) : $strPart;
$bFirst = false;
}
return $strName;
}
push @EXPORT, qw(testRunName);
####################################################################################################################################
# testRun
####################################################################################################################################
sub testRun
{
# Assign function parameters, defaults, and log debug info
my
(
$strOperation,
$strModule,
$strModuleTest,
) =
logDebugParam
(
__PACKAGE__ . '::testRun', \@_,
{name => 'strModule', trace => true},
{name => 'strModuleTest', trace => true},
);
# Error if the test run is already defined - only one run per process is allowed
if (defined($oTestRun))
{
confess &log(ASSERT, 'a test run has already been created in this process');
}
my $strModuleName =
'pgBackRestTest::Module::' . testRunName($strModule) . '::' . testRunName($strModule) . testRunName($strModuleTest) .
'Test';
$oTestRun = eval( ## no critic (BuiltinFunctions::ProhibitStringyEval)
"require ${strModuleName}; ${strModuleName}->import(); return new ${strModuleName}();")
or do {confess $EVAL_ERROR};
# Return from function and log return values if any
return logDebugReturn
(
$strOperation,
{name => 'oRun', value => $oTestRun, trace => true}
);
}
push @EXPORT, qw(testRun);
####################################################################################################################################
# testRunGet
####################################################################################################################################
sub testRunGet
{
return $oTestRun;
}
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
####################################################################################################################################
sub storageTest
{
return $oStorage;
}
push(@EXPORT, qw(storageTest));
####################################################################################################################################
# Getters
####################################################################################################################################
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}}
sub doLogForce {return shift->{bLogForce}}
sub group {return shift->{strGroup}}
sub isDryRun {return shift->{bDryRun}}
sub expect {return shift->{oExpect}}
sub module {return shift->{strModule}}
sub moduleTest {return shift->{strModuleTest}}
sub pgBinPath {return shift->{strPgBinPath}}
sub pgUser {return shift->{strPgUser}}
sub pgVersion {return shift->{strPgVersion}}
sub runCurrent {return shift->{iRun}}
sub stanza {return 'db'}
sub testPath {return shift->{strTestPath}}
sub vm {return shift->{strVm}}
sub vmId {return shift->{iVmId}}
1;