#################################################################################################################################### # 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::Base; use pgBackRest::Storage::Storage; use pgBackRest::Version; use pgBackRestTest::Common::BuildTest; 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 executing. 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 declare one. #################################################################################################################################### sub initModule {} #################################################################################################################################### # initTest # # Empty init sub in case the ancestor class does not declare one. #################################################################################################################################### sub initTest {} #################################################################################################################################### # cleanTest # # Delete all files in test directory. #################################################################################################################################### sub cleanTest { my $self = shift; executeTest('rm -rf ' . $self->testPath() . '/*'); } #################################################################################################################################### # cleanModule # # Empty final sub in case the ancestor class does not declare 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->{strLogLevelTestFile}, $self->{strPgUser}, $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 => 'strLogLevelTestFile'}, {name => 'strPgUser'}, {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::Storage(STORAGE_LOCAL, {strPath => $self->testPath()}); # Generate backrest exe $self->{strBackRestExe} = defined($self->{strBackRestExeC}) ? $self->{strBackRestExeC} : $self->{strBackRestExeHelper}; 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("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); #################################################################################################################################### # 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 basePath {return shift->{strBasePath}} sub dataPath {return shift->basePath() . '/test/data'} sub doCleanup {return shift->{bCleanup}} sub doExpect {return shift->{bExpect}} sub doLogForce {return shift->{bLogForce}} sub logLevelTestFile {return shift->{strLogLevelTestFile}} 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;