669 lines
19 KiB
Perl
669 lines
19 KiB
Perl
=head1 expectedFail.pm
|
|
|
|
Documentation for expectedFail.pm
|
|
|
|
=head1 Overview
|
|
|
|
The module expectedFail.pm supplies the capability of checking if a failed test is expected to fail.
|
|
It is called directly from either test_driver.sh (for batch and interactive tests) or build-namelist_test.pl.
|
|
Future plans involve integrating this module into cesm tests.
|
|
|
|
=head1 Use Case
|
|
|
|
This is a new feature being added to the existing CLM test infrastructure. The use case would roughly be
|
|
along the lines of:
|
|
|
|
1) Run the test suite (CLM batch,interactive or namelist)
|
|
2) Search for test failures
|
|
a) Fix failed tests
|
|
b) -or- Add new xFail entries to XML file if a test is supposed to fail (eg. due to some missing resolution).
|
|
3) Check for new tests that now pass. This is for modifying the ChangeLog.
|
|
4) Update XML file by either adding new entries or removing old ones.
|
|
5) update the ChangeLog to reflect important changes in test behavior (Tests that now pass that failed before, tests that
|
|
are now xFail, etc...
|
|
|
|
=head2 Public methods
|
|
|
|
There are two public methods needed. The "new" ctor and one of the parseOutput* methods.
|
|
Everything else is private.
|
|
|
|
xFail::expectedFail->new
|
|
parseOutput
|
|
parseOutputCLM
|
|
|
|
=head2 Private methods
|
|
|
|
sub _searchExpectedFail
|
|
sub _readXml
|
|
sub _testNowPassing
|
|
sub _printOutput
|
|
sub _getTestType
|
|
sub _getMachInfo
|
|
|
|
=cut
|
|
|
|
package xFail::expectedFail;
|
|
|
|
our $VERSION = '1.00';
|
|
|
|
use Cwd;
|
|
use strict;
|
|
use Getopt::Long;
|
|
use English;
|
|
use Scalar::Util qw(looks_like_number);
|
|
|
|
my @testList={};
|
|
my $DEBUG=0;
|
|
|
|
my $pass=" PASS";
|
|
my $fail=" FAIL";
|
|
my $xfail="xFAIL";
|
|
|
|
##############################################################################
|
|
#
|
|
##############################################################################
|
|
|
|
=head1 CTOR
|
|
|
|
Constructor for the class. Reads in three arguments:
|
|
_callingName -> name of the script creating the new object
|
|
_compareGenerate -> compare or generate option
|
|
_totTests -> total number of tests to run
|
|
|
|
Calls _readXml which reads the file expectedClmTestFails.xml and stores it memory
|
|
for later searches.
|
|
|
|
returns: new object ($self)
|
|
|
|
=cut
|
|
|
|
##############################################################################
|
|
#
|
|
##############################################################################
|
|
sub new {
|
|
my ($class_name) = @_;
|
|
my $self = {
|
|
_className => shift,
|
|
_callingName => shift,
|
|
_compareGenerate => shift,
|
|
_totTests => shift,
|
|
_foundList => undef,
|
|
_numericalTestId => undef
|
|
};
|
|
|
|
if ($DEBUG) {
|
|
print "$self->{_callingName}\n";
|
|
print "$self->{_compareGenerate}\n";
|
|
}
|
|
|
|
bless ($self, $class_name);
|
|
|
|
$self->{_numericalTestId}=0;
|
|
$self->{_created} = 1;
|
|
|
|
$self->_readXml();
|
|
|
|
return $self;
|
|
}
|
|
|
|
##############################################################################
|
|
#
|
|
##############################################################################
|
|
|
|
=head1 parseOutput
|
|
|
|
parseOutput parsese the output from the build-namelist_test.pl script. It is similar
|
|
to, but not interchangable with parseOutputCLM.
|
|
|
|
The only argument is that of the reference variable that contains the information dumped
|
|
by Test::More.
|
|
|
|
returns: nothing
|
|
|
|
=cut
|
|
|
|
##############################################################################
|
|
#
|
|
##############################################################################
|
|
sub parseOutput
|
|
{
|
|
|
|
|
|
my $report;
|
|
my $testId;
|
|
my @testName={};
|
|
my $testReason;
|
|
|
|
my ($self, $output) = @_ ;
|
|
|
|
#_#===========================================
|
|
#_# keep this in for logging
|
|
#_#===========================================
|
|
print ("captured output is :: \n $output \n");
|
|
|
|
#_# split the output from Test::More output on newline
|
|
my @refList = split('\n', $output);
|
|
|
|
#_# process any buffered output which happens when a subroutine from build-namelist_test.pl
|
|
#_# itself calls some testing routines
|
|
foreach my $refSplit (@refList) {
|
|
|
|
#_# always look at the last element of refSplit since that will have the info. from the
|
|
#_# last test run
|
|
|
|
my @outArr=split(/ /,$refSplit);
|
|
|
|
if ($DEBUG) {
|
|
print ("\nxFail::expectedFail::parseOutput @outArr[0] \n");
|
|
print ("xFail::expectedFail::parseOutput @outArr[1] \n");
|
|
print ("xFail::expectedFail::parseOutput @outArr[2] \n");
|
|
print ("xFail::expectedFail::parseOutput @outArr[3] \n");
|
|
print ("xFail::expectedFail::parseOutput @outArr[4] \n");
|
|
}
|
|
|
|
my $size = @outArr-1;
|
|
|
|
#_# first case, we have a passed (ok) test
|
|
if (@outArr[0] eq "ok") {
|
|
$self->{_numericalTestId}++;
|
|
|
|
$report=$pass;
|
|
$testId=@outArr[1];
|
|
@testName=@outArr[3..$size];
|
|
$testReason="";
|
|
|
|
my ($retVal,$xFailText)=$self->_searchExpectedFail($testId);
|
|
|
|
my $testReason=$self->_testNowPassing($testId,$retVal,$xFailText);
|
|
|
|
if($DEBUG){
|
|
print("$testReason \n");
|
|
}
|
|
|
|
$self->_printOutput($report,$testId,$testReason,@testName);
|
|
|
|
|
|
#_# deal with the case of a failed (not ok) test
|
|
} elsif (@outArr[0] eq "not") {
|
|
$self->{_numericalTestId}++;
|
|
|
|
$testId=@outArr[2];
|
|
my ($retVal,$xFailText)=$self->_searchExpectedFail($testId);
|
|
|
|
if ($DEBUG) {
|
|
print ("xFail::expectedFail::parseOutput Id $retVal,$xFailText \n");
|
|
}
|
|
|
|
@testName=@outArr[4..$size];
|
|
|
|
if ($retVal eq "TRUE"){
|
|
#_# found an expected FAIL (xFAIL)
|
|
$report=$xfail;
|
|
$testReason= "<Note: $xFailText>";
|
|
} else {
|
|
#_# print a regular FAIL
|
|
$report=$fail;
|
|
$testReason="";
|
|
}
|
|
|
|
$self->_printOutput($report,$testId,$testReason,@testName);
|
|
|
|
} else {
|
|
#_# skipping line. Trying to parse error code from Test::More
|
|
}
|
|
|
|
}
|
|
|
|
#_# this resets the reference that points to $output (\$captOut) on the caller side
|
|
@_[1]="";
|
|
|
|
}
|
|
|
|
##############################################################################
|
|
#
|
|
##############################################################################
|
|
|
|
=head1 parseOutputCLM
|
|
|
|
parseOutputCLM parsese the output from the test_driver.sh script. It is similar
|
|
to, but not interchangable with parseOutput.
|
|
|
|
parseOutputCLM takes one arguments:
|
|
$statFoo-> the name of the td.<pid>.status file
|
|
|
|
returns: nothing
|
|
|
|
=cut
|
|
|
|
##############################################################################
|
|
#
|
|
##############################################################################
|
|
sub parseOutputCLM
|
|
{
|
|
|
|
my $report;
|
|
my $testId;
|
|
my @testName={};
|
|
my $testReason;
|
|
|
|
my ($self, $statFoo) = @_ ;
|
|
|
|
open(FOO, "< $statFoo"); # open for input
|
|
open(FOO_OUT, "> $statFoo.xFail"); # open for input
|
|
|
|
my(@reportLines);
|
|
|
|
while (<FOO>) {
|
|
|
|
my($line) = $_;
|
|
|
|
my @outArr=split(/ /,$line);
|
|
if (looks_like_number(@outArr[0])) {
|
|
|
|
$self->{_numericalTestId}++;
|
|
|
|
my $num=sprintf("%03d", $self->{_numericalTestId});
|
|
my $totNum=sprintf("%03d", $self->{_totTests});
|
|
|
|
#_# last element has the pass/fail info.
|
|
chomp(@outArr[-1]);
|
|
my $repPass=substr(@outArr[-1], -4, 4);
|
|
|
|
if ($DEBUG) {
|
|
print ("xFail::expectedFail::parseOutput @outArr[0] \n");
|
|
print ("xFail::expectedFail::parseOutput @outArr[1] \n");
|
|
print ("xFail::expectedFail::parseOutput @outArr[2] \n");
|
|
print ("xFail::expectedFail::parseOutput @outArr[3] \n");
|
|
print ("xFail::expectedFail::parseOutput @outArr[4] \n");
|
|
print ("xFail::expectedFail::parseOutput @outArr[5] \n");
|
|
print ("xFail::expectedFail::parseOutput @outArr[6] \n");
|
|
print ("xFail::expectedFail::parseOutput @outArr[-1] \n");
|
|
print ("xFail::expectedFail::parseOutput $repPass \n");
|
|
}
|
|
|
|
my $size = @outArr-1;
|
|
if ($DEBUG) {
|
|
print ("size of line $size \n");
|
|
}
|
|
my $endOfDesc=$size-1;
|
|
|
|
if ($repPass eq "PASS") {
|
|
$report=$pass;
|
|
$testId=@outArr[1];
|
|
@testName=@outArr[2..$endOfDesc];
|
|
|
|
my ($retVal,$xFailText)=$self->_searchExpectedFail($testId);
|
|
|
|
my $testReason=$self->_testNowPassing($testId,$retVal,$xFailText);
|
|
|
|
#_# print out the test results
|
|
print FOO_OUT ("$num/$totNum <$report> <Test Id: $testId> <Desc: @testName> $testReason \n");
|
|
|
|
} else {
|
|
$testId=@outArr[1];
|
|
my ($retVal,$xFailText)=$self->_searchExpectedFail($testId);
|
|
|
|
if ($DEBUG) {
|
|
print ("xFail::expectedFail::parseOutput Id $retVal,$xFailText \n");
|
|
}
|
|
|
|
@testName=@outArr[2..$endOfDesc];
|
|
|
|
if ($retVal eq "TRUE"){
|
|
#_# found an expected FAIL (xFAIL)
|
|
$report=$xfail;
|
|
$testReason= "<Note: $xFailText>";
|
|
} else {
|
|
#_# print a regular FAIL
|
|
$report=$fail;
|
|
$testReason="";
|
|
}
|
|
|
|
#_# print out the test results
|
|
print FOO_OUT ("$num/$totNum <$report> <Test Id: $testId> <Desc: @testName> $testReason \n");
|
|
|
|
}
|
|
|
|
} else {
|
|
print FOO_OUT $line;
|
|
}
|
|
}
|
|
close(FOO);
|
|
close(FOO_OUT);
|
|
}
|
|
|
|
##############################################################################
|
|
#
|
|
##############################################################################
|
|
|
|
=head1 _searchExpectedFail
|
|
|
|
searches the list of expected fails for a match with testId.
|
|
|
|
_searchExpectedFail takes one arguments:
|
|
$testId-> the test id (numerical or string) that we want to search for
|
|
|
|
returns: $retVal (TRUE or FALSE) if id was found
|
|
$text text from XML file
|
|
|
|
=cut
|
|
|
|
##############################################################################
|
|
#
|
|
##############################################################################
|
|
sub _searchExpectedFail
|
|
{
|
|
my ( $self,$testId) = @_;
|
|
|
|
#search through list for test ID
|
|
my $retVal="FALSE";
|
|
|
|
if ($DEBUG) {
|
|
print ("here 2 Id $self->{_foundList} \n");
|
|
}
|
|
if ($self->{_foundList} eq "FALSE"){
|
|
if ($DEBUG) {
|
|
print ("returning early Id \n");
|
|
}
|
|
return $retVal;
|
|
}
|
|
|
|
my $failType;
|
|
my $text;
|
|
foreach my $tL (@testList) {
|
|
my %tAtts = $tL->get_attributes();
|
|
my $tid=$tAtts{'testId'};
|
|
if ($DEBUG) {
|
|
print ("_seachExpectedFail Id $tid $testId \n");
|
|
}
|
|
if ($tid eq $testId) {
|
|
if ($DEBUG) {
|
|
print ("here Id \n");
|
|
}
|
|
#~# found the test we're looking for
|
|
$text=$tL->get_text();
|
|
$failType=$tAtts{'failType'};
|
|
if ($failType eq "xFail"){
|
|
$retVal="TRUE";
|
|
}
|
|
}
|
|
}
|
|
return ($retVal,$text);
|
|
}
|
|
|
|
##############################################################################
|
|
#
|
|
##############################################################################
|
|
|
|
=head1 _readXml
|
|
|
|
reads the xml file for a particular machine, compiler, test type and (compare
|
|
| generate) setup and saves it in memory for searching by _searchExpectedFail.
|
|
|
|
_readXml takes no arguments
|
|
|
|
returns: nothing
|
|
|
|
=cut
|
|
|
|
##############################################################################
|
|
#
|
|
##############################################################################
|
|
sub _readXml
|
|
{
|
|
my ( $self ) = @_;
|
|
|
|
#Figure out where configure directory is and where can use the XML/Lite module from
|
|
my $ProgName;
|
|
($ProgName = $PROGRAM_NAME) =~ s!(.*)/!!; # name of program
|
|
my $ProgDir = $1; # name of directory where program lives
|
|
|
|
my $cwd = getcwd(); # current working directory
|
|
my $cfgdir;
|
|
|
|
if ($ProgDir) { $cfgdir = $ProgDir; }
|
|
else { $cfgdir = $cwd; }
|
|
|
|
#-----------------------------------------------------------------------------------------------
|
|
# Add $cfgdir to the list of paths that Perl searches for modules
|
|
my @dirs = ( $cfgdir, "$cfgdir/perl5lib",
|
|
"$cfgdir/../../cime/utils/perl5lib",
|
|
"$cfgdir/../../../../cime/utils/perl5lib"
|
|
);
|
|
unshift @INC, @dirs;
|
|
my $result = eval "require XML::Lite";
|
|
if ( ! defined($result) ) {
|
|
die <<"EOF";
|
|
** Cannot find perl module \"XML/Lite.pm\" from directories: @dirs **
|
|
EOF
|
|
}
|
|
|
|
#-----------------------------------------------------------------------------------------------
|
|
|
|
my ($machine,$compiler)=_getMachInfo();
|
|
|
|
my $testType=$self->_getTestType($self->{_callingName});
|
|
|
|
|
|
my $xmlFile=undef;
|
|
if ($testType eq "clmInteractive" || $testType eq "clmBatch") {
|
|
$xmlFile = "$cfgdir/expectedClmTestFails.xml";
|
|
} elsif ($testType eq "namelistTest") {
|
|
$xmlFile = "xFail/expectedClmTestFails.xml";
|
|
} else {
|
|
$xmlFile = "xFail/expectedClmTestFails.xml";
|
|
}
|
|
my $xml = XML::Lite->new($xmlFile);
|
|
|
|
my $root = $xml->root_element();
|
|
|
|
if ($DEBUG) {
|
|
print "_readXml $self->{_callingName}\n";
|
|
print "_readXml $self->{_compareGenerate}\n";
|
|
print "_readXml $xmlFile \n";
|
|
print ("_readXml Debug testType $testType \n");
|
|
print ("_readXml Debug machine $machine \n");
|
|
print ("_readXml Debug compiler $compiler \n");
|
|
}
|
|
|
|
# Check for valid root node
|
|
my $name = $root->get_name();
|
|
$name eq "expectedFails" or die
|
|
"readExpectedFail.pm::_readXml :: $xmlFile is not a file that contains expected test failures\n";
|
|
|
|
my @e = $xml->elements_by_name($testType);
|
|
|
|
$self->{_foundList}="FALSE";
|
|
|
|
### populate list of tests for a specfic test type, machine and compiler
|
|
### there's got to be a better way to write this
|
|
while ( my $e = shift @e ) {
|
|
my @mChildren = $e->get_children();
|
|
foreach my $mChild (@mChildren) {
|
|
my $mName=$mChild->get_name();
|
|
if ($mName eq $machine){
|
|
my @cChildren = $mChild->get_children();
|
|
foreach my $cChild (@cChildren) {
|
|
my $cName=$cChild->get_name();
|
|
if ($cName eq $compiler) {
|
|
my @cgChildren=$cChild->get_children();
|
|
foreach my $cgChild (@cgChildren) {
|
|
my $cgName=$cgChild->get_name();
|
|
if($cgName eq $self->{_compareGenerate}){
|
|
@testList=$cgChild->get_children();
|
|
$self->{_foundList}="TRUE";
|
|
last;
|
|
}
|
|
}
|
|
}
|
|
}
|
|
}
|
|
}
|
|
}
|
|
if ($DEBUG) {
|
|
print ("here 1 $self->{_foundList} \n");
|
|
}
|
|
}
|
|
|
|
##############################################################################
|
|
#
|
|
##############################################################################
|
|
|
|
=head1 _testNowPassing
|
|
|
|
reads the xml file for a particular machine, compiler, test type and (compare
|
|
| generate) setup and saves it in memory for searching by _searchExpectedFail.
|
|
|
|
_testNowPassing takes three arguments:
|
|
$id - test id to print out
|
|
$retVal - TRUE or FALSE. Was the id found in the expected fail list
|
|
$xmlText - text from the XML notes section of the file. (Currently not used,
|
|
may be used in future).
|
|
|
|
returns: a text string
|
|
|
|
=cut
|
|
|
|
##############################################################################
|
|
#
|
|
##############################################################################
|
|
sub _testNowPassing
|
|
{
|
|
|
|
my ($self, $id, $retVal, $xmlText) = @_ ;
|
|
my $text=undef;
|
|
|
|
if ($retVal eq "TRUE") {
|
|
#_# found a test that passes now, but is listed as an xFail
|
|
$text = "<NOTE: $id is a new PASS; was xFAIL>\n";
|
|
|
|
} else {
|
|
#_# this test passes and was not previously listed as an xFail
|
|
#_# noOp
|
|
}
|
|
|
|
return $text;
|
|
}
|
|
|
|
##############################################################################
|
|
#
|
|
##############################################################################
|
|
|
|
=head1 _printOutput
|
|
|
|
method that prints output for status files.
|
|
|
|
_printOutput takes four arguments:
|
|
$report - PASS,FAIL,xFAIL
|
|
$testId - test id to print out
|
|
$testReason - for xFAIL and new PASSES, additional reporting
|
|
@testName - test description from original test
|
|
|
|
returns: a text string
|
|
|
|
=cut
|
|
|
|
##############################################################################
|
|
#
|
|
##############################################################################
|
|
sub _printOutput
|
|
{
|
|
|
|
my ($self, $report, $testId, $testReason, @testName) = @_ ;
|
|
|
|
#_# print out the test results
|
|
my $num=sprintf("%03d", $self->{_numericalTestId});
|
|
my $totNum=sprintf("%03d", $self->{_totTests});
|
|
print ("$num/$totNum <$report> <Test Id: $testId> <Desc: @testName> $testReason \n");
|
|
|
|
}
|
|
|
|
##############################################################################
|
|
#
|
|
##############################################################################
|
|
|
|
=head1 _getTestType
|
|
|
|
method that takes the name of the calling script and returns the type of
|
|
test. Used for searching the expected fail list.
|
|
|
|
_getTestType takes four arguments:
|
|
$name - name of calling script
|
|
|
|
returns: $type, the type of test
|
|
|
|
=cut
|
|
|
|
##############################################################################
|
|
#
|
|
##############################################################################
|
|
sub _getTestType
|
|
{
|
|
|
|
my ($self, $name) = @_ ;
|
|
|
|
if($DEBUG){
|
|
print ("_getTestType $name");
|
|
}
|
|
|
|
my %testTypes = (
|
|
"build-namelist_test.pl" => "namelistTest",
|
|
"test_driver.sh-i" => "clmInteractive",
|
|
"test_driver.sh" => "clmBatch",
|
|
"clm-cesm.sh" => "cesm"
|
|
);
|
|
|
|
my $type = $testTypes {lc $name} || "unknown";
|
|
return $type;
|
|
|
|
}
|
|
|
|
##############################################################################
|
|
#
|
|
##############################################################################
|
|
|
|
=head1 _getMachInfo
|
|
|
|
method that figures out on what platform this is running and returns a 2 digit
|
|
machine identifier and the compiler. This will eventually contain multiple
|
|
compiler for various machines.
|
|
|
|
_getMachInfo takes no arguments
|
|
|
|
returns: $mach - the machine I'm running on
|
|
$comp - the compiler being used
|
|
|
|
=cut
|
|
|
|
##############################################################################
|
|
#
|
|
##############################################################################
|
|
sub _getMachInfo
|
|
{
|
|
|
|
my $name=`uname -n`;
|
|
$name = substr($name, 0, 2);
|
|
|
|
my %machNames = (
|
|
"ys" => "yellowstone",
|
|
"fr" => "frankfurt"
|
|
);
|
|
|
|
my %compNames = (
|
|
"ys" => "INTEL",
|
|
"fr" => "INTEL"
|
|
);
|
|
|
|
my $mach = $machNames {lc $name} || "unknown";
|
|
my $comp = $compNames {lc $name} || "unknown";
|
|
|
|
return ($mach,$comp);
|
|
|
|
}
|
|
|
|
# A Perl module must end with a true value or else it is considered not to
|
|
# have loaded. By convention this value is usually 1 though it can be
|
|
# any true value. A module can end with false to indicate failure but
|
|
# this is rarely used and it would instead die() (exit with an error).
|
|
1;
|