mirror of
https://github.com/pgbackrest/pgbackrest.git
synced 2024-12-14 10:13:05 +02:00
801e2a5a2c
This brings consistency between the C and Perl constants and allows for easier code reuse.
629 lines
21 KiB
Perl
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;
|