417 lines
14 KiB
Perl
Executable File
417 lines
14 KiB
Perl
Executable File
#!/usr/bin/env perl
|
|
#=======================================================================
|
|
#
|
|
# Parse a cime5 cs.status file to give summary output
|
|
#
|
|
# Usage:
|
|
#
|
|
# ./parse_cime.cs.status <cs.status.id filename>
|
|
#
|
|
# Erik Kluzek
|
|
# Sep/19/2016
|
|
#
|
|
#=======================================================================
|
|
use Cwd;
|
|
use strict;
|
|
#use diagnostics;
|
|
use English;
|
|
use Getopt::Long;
|
|
use IO::File;
|
|
|
|
#-----------------------------------------------------------------------------------------------
|
|
# Set the directory that contains this scripts. If the command was issued using a
|
|
# relative or absolute path, that path is in $ProgDir. Otherwise assume the
|
|
# command was issued from the current working directory.
|
|
|
|
sub GetNameNDir {
|
|
(my $ProgName = $0) =~ s!(.*)/!!; # name of this script
|
|
my $ProgDir = $1; # name of directory containing this script -- may be a
|
|
# relative or absolute path, or null if the script is in
|
|
# the user's PATH
|
|
my $cmdline = "@ARGV"; # Command line arguments to script
|
|
my $cwd = getcwd(); # current working directory
|
|
my $scrdir; # absolute pathname of directory that contains this script
|
|
my $nm = "$ProgName::"; # name to use if script dies
|
|
if ($ProgDir) {
|
|
$scrdir = absolute_path($ProgDir);
|
|
} else {
|
|
$scrdir = $cwd;
|
|
}
|
|
return( $ProgName, $scrdir );
|
|
}
|
|
|
|
|
|
#-----------------------------------------------------------------------------------------------
|
|
|
|
sub usage {
|
|
my $ProgName = shift;
|
|
die <<EOF;
|
|
SYNOPSIS
|
|
$ProgName <cs.status file> [options]
|
|
REQUIRED OPTIONS
|
|
<cs.status files> cime5 cs.status. file(s) that will be run and parsed
|
|
At least one file needs to be given, but you can also
|
|
give a list of space seperated files.
|
|
OPTIONS
|
|
-die_on_duplicate Die if find a duplicate testname
|
|
-summarize [or -s] Summarize results into lists of tests in categories (pend, pass, fail etc.)
|
|
-sum_results_perline Summarize results categories of each test into one line
|
|
-help [or -h] Print usage to STDOUT.
|
|
-verbose [or -v] Make output more verbose.
|
|
|
|
-summarize and -sum_results_perline can NOT both be asked for as they contrdict each other.
|
|
EOF
|
|
}
|
|
|
|
#-----------------------------------------------------------------------------------------------
|
|
|
|
|
|
sub process_cmdline {
|
|
# Process command-line options.
|
|
my $ProgName = shift;
|
|
|
|
my %opts = (
|
|
csstatusfiles_ref => undef,
|
|
sumintocats => 0,
|
|
sumperline => 0,
|
|
dieondup => 0,
|
|
help => 0,
|
|
verbose => 0,
|
|
);
|
|
|
|
GetOptions(
|
|
"h|help" => \$opts{'help'},
|
|
"s|summarize" => \$opts{'sumintocats'},
|
|
"die_on_duplicate" => \$opts{'dieondup'},
|
|
"sum_results_perline" => \$opts{'sumperline'},
|
|
"v|verbose" => \$opts{'verbose'},
|
|
) or usage($ProgName);
|
|
|
|
# Give usage message.
|
|
usage($ProgName) if $opts{'help'};
|
|
|
|
# If bad input
|
|
if ( $opts{'sumintocats'} && $opts{'sumperline'} ) {
|
|
print "ERROR: options -summarize and -sum_results_perline contradict each other, choose one or the other or neither\n";
|
|
usage($ProgName);
|
|
}
|
|
|
|
# Get cs.status filenames
|
|
$opts{'csstatusfiles_ref'} = \@ARGV;
|
|
|
|
my $files_ref = $opts{'csstatusfiles_ref'};
|
|
|
|
if ( $#$files_ref == -1 ) {
|
|
print "ERROR: cs.status filename(s) was (were) NOT input\n";
|
|
usage($ProgName);
|
|
}
|
|
|
|
foreach my $file ( @$files_ref ) {
|
|
if ( ! -x $file ) {
|
|
print "ERROR: cs.status filename does NOT exist: $file\n";
|
|
usage($ProgName);
|
|
}
|
|
}
|
|
|
|
return( %opts );
|
|
}
|
|
|
|
#-------------------------------------------------------------------------------
|
|
|
|
sub absolute_path {
|
|
#
|
|
# Convert a pathname into an absolute pathname, expanding any . or .. characters.
|
|
# Assumes pathnames refer to a local filesystem.
|
|
# Assumes the directory separator is "/".
|
|
#
|
|
my $path = shift;
|
|
my $cwd = getcwd(); # current working directory
|
|
my $abspath; # resulting absolute pathname
|
|
|
|
# Strip off any leading or trailing whitespace. (This pattern won't match if
|
|
# there's embedded whitespace.
|
|
$path =~ s!^\s*(\S*)\s*$!$1!;
|
|
|
|
# Convert relative to absolute path.
|
|
|
|
if ($path =~ m!^\.$!) { # path is "."
|
|
return $cwd;
|
|
} elsif ($path =~ m!^\./!) { # path starts with "./"
|
|
$path =~ s!^\.!$cwd!;
|
|
} elsif ($path =~ m!^\.\.$!) { # path is ".."
|
|
$path = "$cwd/..";
|
|
} elsif ($path =~ m!^\.\./!) { # path starts with "../"
|
|
$path = "$cwd/$path";
|
|
} elsif ($path =~ m!^[^/]!) { # path starts with non-slash character
|
|
$path = "$cwd/$path";
|
|
}
|
|
|
|
my ($dir, @dirs2);
|
|
my @dirs = split "/", $path, -1; # The -1 prevents split from stripping trailing nulls
|
|
# This enables correct processing of the input "/".
|
|
|
|
# Remove any "" that are not leading.
|
|
for (my $i=0; $i<=$#dirs; ++$i) {
|
|
if ($i == 0 or $dirs[$i] ne "") {
|
|
push @dirs2, $dirs[$i];
|
|
}
|
|
}
|
|
@dirs = ();
|
|
|
|
# Remove any "."
|
|
foreach $dir (@dirs2) {
|
|
unless ($dir eq ".") {
|
|
push @dirs, $dir;
|
|
}
|
|
}
|
|
@dirs2 = ();
|
|
|
|
# Remove the "subdir/.." parts.
|
|
foreach $dir (@dirs) {
|
|
if ( $dir !~ /^\.\.$/ ) {
|
|
push @dirs2, $dir;
|
|
} else {
|
|
pop @dirs2; # remove previous dir when current dir is ..
|
|
}
|
|
}
|
|
if ($#dirs2 == 0 and $dirs2[0] eq "") { return "/"; }
|
|
$abspath = join '/', @dirs2;
|
|
return( $abspath );
|
|
}
|
|
|
|
sub run_csstatus {
|
|
# run a cs.status file and parse it's output
|
|
my ( $csstatusfilename, $verbose, $csstatus_ref, $dieondup ) = @_;
|
|
|
|
if ( ! -x $csstatusfilename ) {
|
|
die "ERROR: cs.status file does NOT exist or can not execute: $csstatusfilename\n";
|
|
}
|
|
my $csdate = undef;
|
|
if ( $csstatusfilename =~ /cs.status.([0-9_]+)/ ) {
|
|
$csdate = $1;
|
|
chomp( $csdate );
|
|
}
|
|
if ( $verbose ) { print "Parse file: $csstatusfilename\n"; }
|
|
my @lines = `$csstatusfilename`;
|
|
while ( my $line = shift(@lines) ) {
|
|
if ( $line =~ /([^ ]+) \(Overall: ([^ ,]+)\)/ ) {
|
|
my $test = $1;
|
|
my $over = $2;
|
|
my $fails = ""; my $passes = ""; my $pendings = "";
|
|
my $newline;
|
|
my $bfail = 0;
|
|
if ( $verbose ) { print "$test\n"; }
|
|
do {
|
|
$newline = shift(@lines);
|
|
if ( $newline =~ /FAIL[ ]+$test ([^ ]+)/ ) {
|
|
$fails .= " $1";
|
|
chomp( $fails );
|
|
if ( $1 eq "BASELINE" ) {
|
|
if ( $newline =~ /ERROR BFAIL baseline directory/ ) {
|
|
$bfail = 1;
|
|
}
|
|
}
|
|
} elsif ( $newline =~ /PASS[ ]+$test ([^ ]+)/ ) {
|
|
$passes .= " $1";
|
|
chomp( $passes );
|
|
} elsif ( $newline =~ /PEND[ ]+$test ([^ ]+)/ ) {
|
|
$pendings .= " $1";
|
|
chomp( $pendings );
|
|
} elsif ( (! $newline) || ($newline =~ /Overall:/) ) {
|
|
} else {
|
|
if ( $verbose ) { print "ERROR: parsing line: $newline\n"; }
|
|
}
|
|
} until ( (! $newline) || ($newline =~ /Overall:/) );
|
|
if ( $newline ) {
|
|
unshift( @lines, $newline );
|
|
}
|
|
if ( $over eq "NLFAIL" ) {
|
|
$over = "PASS";
|
|
}
|
|
elsif ( $over eq "NLCOMP" ) {
|
|
$over = "PASS";
|
|
}
|
|
elsif ( $over eq "DIFF" ) {
|
|
if ( $bfail ) {
|
|
$over = "FAIL_BDNE";
|
|
} else {
|
|
$over = "DIFF";
|
|
}
|
|
}
|
|
if ( exists($$csstatus_ref{$test}) ) {
|
|
if ( $dieondup ) {
|
|
die "ERROR: Already had a test that matches this one: $test\n";
|
|
}
|
|
next;
|
|
}
|
|
$$csstatus_ref{$test}{'over'} = $over;
|
|
$$csstatus_ref{$test}{'FAIL'} = $fails;
|
|
$$csstatus_ref{$test}{'PASS'} = $passes;
|
|
$$csstatus_ref{$test}{'PEND'} = $pendings;
|
|
if ( ! $newline ) { last; }
|
|
} else {
|
|
if ( $verbose ) { print( "WARNING: Didn't parse following line:\n$line" ); }
|
|
}
|
|
}
|
|
|
|
}
|
|
|
|
sub print_status {
|
|
# Print status info for each test
|
|
|
|
my %csstatus = @_;
|
|
|
|
foreach my $key ( keys(%csstatus) ) {
|
|
foreach my $type ( "PASS", "FAIL", "PEND" ) {
|
|
if ( $csstatus{$key}{$type} ne "" ) {
|
|
foreach my $phase ( split( / /, $csstatus{$key}{$type}) ) {
|
|
if ( $phase =~ /[^ ]+/ ) {
|
|
printf( "%-10s %-90s %s\n", $type, $key, $phase );
|
|
}
|
|
}
|
|
}
|
|
}
|
|
}
|
|
}
|
|
|
|
sub print_sumperline {
|
|
# Print summary info for each test
|
|
|
|
my %csstatus = @_;
|
|
|
|
foreach my $key ( keys(%csstatus) ) {
|
|
printf( "%-10s %-90s Passing: %s\n", $csstatus{$key}{'over'}, $key, $csstatus{$key}{'PASS'} );
|
|
if ( $csstatus{$key}{'FAIL'} ne "" ) {
|
|
printf( "%-10s %-90s %s\n", "FAIL", $key, $csstatus{$key}{'FAIL'} );
|
|
}
|
|
if ( $csstatus{$key}{'PEND'} ne "" ) {
|
|
printf( "%-10s %-90s %s\n", "PEND", $key, $csstatus{$key}{'PEND'} );
|
|
}
|
|
}
|
|
}
|
|
|
|
|
|
|
|
sub print_categories {
|
|
# Seperate tests into categories
|
|
|
|
my $scrdir = shift(@_);
|
|
my %csstatus = @_;
|
|
|
|
my $expectedfailfile = "$scrdir/components/clm/cime_config/testdefs/ExpectedTestFails.xml";
|
|
if ( ! -f $expectedfailfile ) {
|
|
$expectedfailfile = "$scrdir/cime_config/testdefs/ExpectedTestFails.xml";
|
|
}
|
|
my @passes;
|
|
my @fails;
|
|
my @pendings;
|
|
my @compares_diff;
|
|
my @compares_diff_nobase;
|
|
my @keys = sort( keys(%csstatus) );
|
|
foreach my $key ( @keys ) {
|
|
if ( $csstatus{$key}{'over'} eq "PASS" ) {
|
|
push( @passes, $key );
|
|
} elsif ( $csstatus{$key}{'over'} eq "DIFF" ) {
|
|
push( @passes, $key );
|
|
push( @compares_diff, $key );
|
|
} elsif ( $csstatus{$key}{'over'} eq "FAIL_BDNE" ) {
|
|
push( @passes, $key );
|
|
push( @compares_diff_nobase, $key );
|
|
} elsif ( $csstatus{$key}{'over'} eq "FAIL" ) {
|
|
push( @fails, $key );
|
|
} elsif ( $csstatus{$key}{'over'} eq "PEND" ) {
|
|
push( @pendings, $key );
|
|
} else {
|
|
print( "WARNING: unclassified overall status: $key, $csstatus{$key}{'over'}\n" );
|
|
}
|
|
}
|
|
print( "================================================================================\n" );
|
|
print( "Test summary\n" );
|
|
printf( "%d Total tests\n", $#keys+1 );
|
|
printf( "%d Tests passed\n", $#passes+1 );
|
|
printf( "%d Tests compare different to baseline\n", $#compares_diff+1 );
|
|
printf( "%d Tests are new where there is no baseline\n", $#compares_diff_nobase+1 );
|
|
printf( "%d Tests pending\n", $#pendings+1 );
|
|
printf( "%d Tests failed\n", $#fails+1 );
|
|
print( "================================================================================\n" );
|
|
|
|
if ( $#passes >= 0 ) {
|
|
print( "================================================================================\n" );
|
|
print( "These tests passed\n" );
|
|
print( "================================================================================\n" );
|
|
foreach my $key ( @passes ) {
|
|
my $expect = "";
|
|
`grep $key $expectedfailfile > /dev/null`;
|
|
if ( $? == 0 ) { $expect = "FAILED PREVIOUSLY"; }
|
|
print( "$key\t\t\t$expect\n" );
|
|
}
|
|
}
|
|
if ( $#compares_diff >= 0 ) {
|
|
print( "================================================================================\n" );
|
|
print( "These tests compare different to the baseline\n" );
|
|
print( "================================================================================\n" );
|
|
foreach my $key ( @compares_diff ) {
|
|
print( "$key\n" );
|
|
}
|
|
}
|
|
if ( $#compares_diff_nobase >= 0 ) {
|
|
print( "================================================================================\n" );
|
|
print( "These tests don't have a baseline to compare to\n" );
|
|
print( "================================================================================\n" );
|
|
foreach my $key ( @compares_diff_nobase ) {
|
|
print( "$key\n" );
|
|
}
|
|
}
|
|
if ( $#pendings >= 0 ) {
|
|
print( "================================================================================\n" );
|
|
print( "These tests are pending (some tests may fail in the pending state)\n" );
|
|
print( "================================================================================\n" );
|
|
foreach my $key ( @pendings ) {
|
|
my $expect = "";
|
|
`grep $key $expectedfailfile > /dev/null`;
|
|
if ( $? == 0 ) { $expect = "EXPECTED"; }
|
|
print( "$key\t\t$expect\n" );
|
|
}
|
|
}
|
|
if ( $#fails >= 0 ) {
|
|
print( "================================================================================\n" );
|
|
print( "These tests failed\n" );
|
|
print( "================================================================================\n" );
|
|
foreach my $key ( @fails ) {
|
|
my $expect = "";
|
|
`grep $key $expectedfailfile > /dev/null`;
|
|
if ( $? == 0 ) { $expect = "EXPECTED"; }
|
|
print( "$key\t\t$expect\n" );
|
|
}
|
|
}
|
|
}
|
|
|
|
#-----------------------------------------------------------------------------------------------
|
|
|
|
sub main {
|
|
# main subroutine
|
|
my ($ProgName, $scrdir) = &GetNameNDir( );
|
|
my $pwd = `pwd`;
|
|
chomp( $pwd );
|
|
my %opts = &process_cmdline( $ProgName );
|
|
my %csstatus;
|
|
my $files_ref = $opts{'csstatusfiles_ref'};
|
|
foreach my $file ( @$files_ref ) {
|
|
&run_csstatus( "$pwd/$file", $opts{'verbose'}, \%csstatus, $opts{'dieondup'} );
|
|
}
|
|
if ( $opts{'verbose'} ) {
|
|
print "Print summary of testing:\n";
|
|
}
|
|
if ( $opts{'sumintocats'} ) {
|
|
&print_categories( $scrdir, %csstatus );
|
|
} elsif ( $opts{'sumperline'} ) {
|
|
&print_sumperline( %csstatus );
|
|
} else {
|
|
&print_status( %csstatus );
|
|
}
|
|
}
|
|
|
|
# Invoke the main subroutine
|
|
&main();
|
|
|