#!/usr/bin/env perl use XML::LibXML; use IO::File; use Data::Dumper; use Getopt::Long; use POSIX qw(strftime); use Cwd qw(abs_path); use File::Basename; use strict; #========================================================================== # Globals #========================================================================== my %opts; my $scriptdir = dirname(abs_path(__FILE__)); my $ccsmroot = abs_path("$scriptdir/../../"); my $testlist; my $component; my $banner = "=========================================================================="; { #========================================================================== # Simple attribute class to facilitate easier test parsing.. # # NOTE(wjs, 2014-11-12): it would be great if we could make more use of # this intermediate CESMTests representation, doing more processing of # lists of CESMTests, and less of the xml representation (e.g., via # convertXMLToCESMTests, then processing that list, then converting back # to xml via addXMLTests). # ========================================================================== package CESMTest; sub new { my ($class, %params) = @_; my $self = { # The following are always defined compset => $params{'compset'} || undef, grid => $params{'grid'} || undef, testname => $params{'testname'} || undef, machine => $params{'machine'} || undef, compiler => $params{'compiler'} || undef, # The following are optional for each test testmods => $params{'testmods'} || undef, comment => $params{'comment'} || undef, # The following will only be defined in certain use cases testtype => $params{'testtype'} || undef, }; bless $self, $class; return $self; } } #========================================================================== # Show the usage. #========================================================================== sub usage { my $usgstatement; $usgstatement = < yellowstone.txt Make any modifications necessary to yellowstone.txt manage_testlists -synclist -machine yellowstone -compiler pgi \ -category prebeta -component cesm -file yellowstone.txt This command will delete all tests that match yellowstone, the pgi compiler, and the prebeta category. Then all the potentially modified tests in yellowstone.txt will be added back in. -removetests: This mode is intended delete any tests found matching the specified arguments. Want to delete all the aux_clm tests? manage_testlists -removetests -category aux_clm -component cesm Want to delete all the BG1850CN tests? manage_testlists -removetests -compset BG1850CN -component cesm want to delte the yellowstone aux_science tests using only the gnu compiler? manage_testlists -removetests -category aux_science -machine yellowstone \ -compiler gnu -component cesm Want to remove only tests with the 'clm/decStart' testmod? manage_testlists -removetests -testmods "clm/decStart" -component cesm -cleanxml: This option sorts the xml file, consolidates duplicate nodes, and removes duplicate entries. It should be run after making any manual edits to the xml file, so that the next users of this file are starting from a clean state. This will minimize merge conflicts. Note that sorting is automatically done after other manipulations performed by this program, so this mode of operation only needs to be performed after making manual edits. -list name can be [compsets,grids,compilers,machines,categories,tests] list the available compsets, grids, compilers, machines, categories, or tests. -query: Query the testlist by compset, grid, test, compiler, machine, testmod, or any combination thereof. A note on the PE count specifiers: T, S, M, L, X are not constant. first, they are only defined for a few compsets/resolution combinations. second, they depend on compset and resolution. you can imagine a T31_g37 range being 100 cores to 1000 cores from T to X. but ne240_t12 would probably be 500 at T and 100,000 at X, for instance. the 1, 1x1, 16x4, etc specify the tasks and threads for each component directly. A note about the "points mode" specifier for tests, ie SMS_RL*: "L" is a land point "O" is an ocean point A and B are two points on the land and ocean that CLM provided. so LA, LB, OA, and OB are 4 distinct single test points, 2 over land, 2 over ocean. EOF print $usgstatement; exit(1); } #========================================================================== # Get the options, check the options. #========================================================================== sub getOptions { usage() if(@ARGV < 1); GetOptions( "h|help" => \$opts{'help'}, "f|file=s" => \$opts{'file'}, "a|addlist" => \$opts{'addlist'}, "s|synclist" => \$opts{'synclist'}, "r|removetests" => \$opts{'removetests'}, "cleanxml" => \$opts{'cleanxml'}, "q|query" => \$opts{'query'}, 'l|list=s' => \$opts{'list'}, "outputlist" => \$opts{'outputlist'}, "outputxml" => \$opts{'outputxml'}, "compset=s" => \$opts{'compset'}, "grid=s" => \$opts{'grid'}, "test=s" => \$opts{'test'}, "machine=s" => \$opts{'machine'}, "compiler=s" => \$opts{'compiler'}, "category=s" => \$opts{'category'}, "component=s" => \$opts{'component'}, "testmods=s" => \$opts{'testmods'}, ); usage() if $opts{'help'}; if ( ! defined $opts{'component'} ) { if (defined $opts{'query'} ) { foreach my $comp ('allactive', 'cam ', 'clm', 'cice', 'drv', 'cism', 'pop') { $testlist = setTestlist($comp); query(); } exit(0); } else { print "Must supply a component argument via the -component option \n"; print " values must be [allactive | cam | clm | cice | cism| drv | pop] \n"; exit(1); } } else { $component = $opts{'component'}; $testlist = setTestlist($component); } if(defined $opts{'addlist'} && ! defined $opts{'file'}) { print "To add test lists, you must supply a test list via the -file option\n"; exit(1); } if(defined $opts{'addlist'} && ! defined $opts{'category'}) { print "The -category option is required to add tests\n"; exit(1); } if(defined $opts{'synclist'} && ! defined $opts{'file'}) { print "To sync changes to a test list, you must supply a test list via the -file option\n"; exit(1); } if(defined $opts{'synclist'} && ( ! defined $opts{'compset'} && ! defined $opts{'grid'} && ! defined $opts{'test'} && ! defined $opts{'category'} && ! defined $opts{'machine'} && ! defined $opts{'compiler'} && ! defined $opts{'testmods'})) { print "To sync changes to an existing test list, \n"; print "one or more of the following options must be supplied:\n"; print "compset, grid, test, machine, compiler, or testmods\n"; exit(1); } if(defined $opts{'removetests'} && ! defined $opts{'compset'} && ! defined $opts{'grid'} && ! defined $opts{'test'} && ! defined $opts{'category'} && ! defined $opts{'machine'} && ! defined $opts{'compiler'} && ! defined $opts{'testmods'}) { print "To delete tests from the xml file, \n"; print "one or more of the following options must be supplied:\n"; print "compset, grid, test, machine, compiler, or testmods\n"; exit(1); } if(defined $opts{'list'} && $opts{'list'} !~ /(compsets|grids|compilers|machines|categories|components|tests)/) { print "the -list option must be set to one of the following values: \n"; print "compsets, grids, compilers, machines, categories, components, or tests\n"; } } #========================================================================== # Create a new, blank xml document, which just contains the skeleton into which # we can place tests (i.e., it contains an empty testlist). # ========================================================================== sub blankXML { my $newxml = XML::LibXML::Document->createDocument(); my $root = $newxml->createElement('testlist'); $newxml->setDocumentElement($root); return $newxml; } #========================================================================== # Read the testlist.xml file, return the XML::LibXML::Document #========================================================================== sub readXML { my $xmlfile = shift; my $parser = XML::LibXML->new( no_blanks => 1); my $testxml = $parser->parse_file($testlist); return $testxml; } #========================================================================== # Write the new testlist xml file. #========================================================================== sub writeXML { my ($testxml) = shift; my $dtformat = strftime "%d%b%Y-%H%M%S", localtime; my $newfilename; if ($component eq 'cam') { $newfilename = "$ccsmroot/components/cam/cesmtest/testlist_cam-$dtformat.xml"; } if ($component eq 'allactive') { $newfilename = "$scriptdir/ccsm_utils/Testlistxml/testlist_cesm-$dtformat.xml"; } if ($component eq 'clm') { $newfilename = "$ccsmroot/components/clm/cesmtest/testlist_clm-$dtformat.xml"; } if ($component eq 'cice') { $newfilename = "$ccsmroot/components/cice/cesmtest/testlist_cice-$dtformat.xml"; } if ($component eq 'drv') { $newfilename = "$ccsmroot/cime/driver_cpl/cesmtest/testlist_drv-$dtformat.xml"; } if ($component eq 'cism') { $newfilename = "$ccsmroot/components/cism/cesmtest/testlist_cism-$dtformat.xml"; } if ($component eq 'pop') { $newfilename = "$ccsmroot/components/pop2/cesmtest/testlist_pop-$dtformat.xml"; } print "\n now writing the new test list to $newfilename\n"; print "Please carefully review and/or diff the new file against the\n"; print "original, and if you are satisfied with the changes, move \n"; print "$newfilename to \n"; print "$testlist\n"; print "as in with the unix command: \nmv $newfilename $testlist\n\n"; open my $NEWTESTXML, ">", "$newfilename" or die $?; my $tststring = $testxml->toString(1); print $NEWTESTXML $tststring; close $NEWTESTXML; } #========================================================================== # Sort an array of CESMTests. Return a reference to a sorted array. # # NOTE(wjs, 2014-11-12): Should this be moved into the CESMTest package? # # NOTE(wjs, 2014-11-12): It's possible that we could replace some of the other # sorting done in this file with calls to sortCESMTests. In particular, it would # be great if we could do away with sortXML, since that is a complex routine. # ========================================================================== sub sortCESMTests { my $tests = shift; my @sorted_tests = sort {$a->{compset} cmp $b->{compset} || $a->{grid} cmp $b->{grid} || $a->{testname} cmp $b->{testname} || $a->{machine} cmp $b->{machine} || $a->{compiler} cmp $b->{compiler} || undefToBlank($a->{testmods}) cmp undefToBlank($b->{testmods}) || undefToBlank($a->{comment}) cmp undefToBlank($b->{comment}) || undefToBlank($a->{testtype}) cmp undefToBlank($b->{testtype}) } @$tests; return \@sorted_tests; } #========================================================================== # Convert an undefined value to an empty string. # # This is useful to avoid warnings. #========================================================================== sub undefToBlank { my $val = shift; if (! defined($val)) { $val = ""; } return $val; } #========================================================================== # Parse the text test list. #========================================================================== sub parseTextList { my ($testfile) = @_; open my $TSTFILE, "<", $testfile or die "can't open $testfile"; my @lines = <$TSTFILE>; close $TSTFILE; # We're building a list of CESMTest objects my @tests; my $testsfound = 0; foreach my $line(@lines) { my $comment = undef; chomp $line; # skip blank lines and # commments at the beginning of lines. next if $line =~ m/^$/; next if $line =~ m/^#/; # if we find a comment, split by #, and strip the whitespace. if($line =~ m/#/) { ($line, $comment) = split('\#', $line, 2); # no single quotes in comments, it messes up the XPATH xml searching # when parsing test lists. if($comment =~ /'/) { print "Sorry, quotes aren't allowed in comments. The offending line was:\n"; print "$line$comment\n"; exit(1); } $comment =~ s/^\s+//; $comment =~ s/\s+$//; $line =~ s/^\s+//; $line =~ s/\s+$//; } my ($testname, $grid, $compset, $machcomp, $testmods) = split('\.', $line); # if the split results in an undefined testname, grid, compset, machcomp, machine, or # compiler, complain and exit. my $parse_error = 0; if(! defined $testname || ! defined $grid || ! defined $compset || ! defined $machcomp) { $parse_error = 1; } my ($machine, $compiler) = split('_', $machcomp); if(! defined $machine || ! defined $compiler) { $parse_error = 1; } if($parse_error) { print "Formatting error found in the following line of text in your input file:\n"; print "$line\n"; print "Please review your test list and correct any errors\n"; return undef; } if(defined $testmods) { $testmods =~ s/ //g; $testmods =~ s/-/\//g; } my $tst = new CESMTest(compset => $compset, grid => $grid, testname => $testname, machine => $machine, compiler => $compiler); if(defined $testmods) { $tst->{testmods} = $testmods; } if(defined $comment) { $tst->{comment} = $comment; } push(@tests, $tst); $testsfound++; } print "found $testsfound tests in $testfile\n"; return \@tests; } #========================================================================== # Add a new set of tests. Go through the list of CESMTests, silently ignore # any that happen to already be there, and add the tests that don't yet exist # to a new machine element. Then walk back up the tree of tests, grids, and compsets, # adding any that do not yet exist. # # The global_testtype parameter is optional. If it is supplied, we use it as the # testtype for all tests (ignoring the testtype component of each test). If it # is NOT supplied, then each test must have a testtype component, and we use # that. Also note that global_testtype is a *reference* to a string. # ========================================================================== sub addXMLTests { my ($tests, $testxml, $global_testtype) = @_; my $acounter = 0; foreach my $test(@$tests) { # get the relevant values. my $compset = $test->{compset}; my $grid = $test->{grid}; my $testname = $test->{testname}; my $machine = $test->{machine}; my $compiler = $test->{compiler}; my $testmods = $test->{testmods}; my $comment = $test->{comment}; my $testtype; if (defined $global_testtype) { $testtype = $$global_testtype; } elsif (defined $test->{testtype}) { $testtype = $test->{testtype}; } else { die "ERROR: In addXMLTests, if global_testtype is not provided, each test must contain a testtype component."; } # Search the xml for matchng tests using Xpath queries. my @xmltestnodes; if(defined $test->{comment} && defined $test->{testmods}) { @xmltestnodes = $testxml->findnodes("/testlist/compset[\@name=\'$compset\']/grid[\@name=\'$grid\']/test[\@name=\'$testname\']/machine[text()=\'$machine\' and \@compiler=\'$compiler\' and \@testtype=\'$testtype\' and \@testmods=\'$testmods\' and \@comment=\'$comment\']"); } elsif(! defined $test->{comment} && defined $test->{testmods}) { @xmltestnodes = $testxml->findnodes("/testlist/compset[\@name=\'$compset\']/grid[\@name=\'$grid\']/test[\@name=\'$testname\']/machine[text()=\'$machine\' and \@compiler=\'$compiler\' and \@testtype=\'$testtype\' and \@testmods=\'$testmods\' and not(\@comment) ]"); } elsif( defined $test->{comment} && !defined $test->{testmods}) { @xmltestnodes = $testxml->findnodes("/testlist/compset[\@name=\'$compset\']/grid[\@name=\'$grid\']/test[\@name=\'$testname\']/machine[text()=\'$machine\' and \@compiler=\'$compiler\' and \@testtype=\'$testtype\' and \@comment=\'$comment\' and not(\@testmods) ]"); } elsif( ! defined $test->{comment} && ! defined $test->{testmods}) { @xmltestnodes = $testxml->findnodes("/testlist/compset[\@name=\'$compset\']/grid[\@name=\'$grid\']/test[\@name=\'$testname\']/machine[text()=\'$machine\' and \@compiler=\'$compiler\' and \@testtype=\'$testtype\' and not(\@testmods) and not(\@comment)]"); } # if we find matching tests in the xml, skip adding the test. next if @xmltestnodes; # If we're here, we need to add a new machne element with the machine name # and relevant attributes. my $newmachnode = $testxml->createElement('machine'); $newmachnode->appendText($machine); $newmachnode->setAttribute('compiler', $compiler); $newmachnode->setAttribute('testtype', $testtype); $newmachnode->setAttribute('testmods', $testmods) if defined $testmods; $newmachnode->setAttribute('comment', $comment) if defined $comment; # Now we search for matching compset, grid, and test nodes again using Xpath queries. my $compsetnode; my $gridnode; my $testnode; my @testnodes = $testxml->findnodes("/testlist/compset[\@name=\'$compset\']/grid[\@name=\'$grid\']/test[\@name=\'$testname\']"); my @gridnodes = $testxml->findnodes("/testlist/compset[\@name=\'$compset\']/grid[\@name=\'$grid\']"); my @compsetnodes = $testxml->findnodes("/testlist/compset[\@name=\'$compset\']"); # if a matching test node is found, set the test node to the found test node. Otherwise add # a new one. if(@testnodes) { $testnode = $testnodes[0]; } else { $testnode = $testxml->createElement('test'); $testnode->setAttribute('name', $testname); } $testnode->addChild($newmachnode); $acounter++; # if a matching grid node is found, set the test node to the found test node. Otherwise add # a new one. if(@gridnodes) { $gridnode = $gridnodes[0]; } else { $gridnode = $testxml->createElement('grid'); $gridnode->setAttribute('name', $grid); } # if a matching compset node is found, set the test node to the found test node. Otherwise add # a new one. if(@compsetnodes) { $compsetnode = $compsetnodes[0]; } else { $compsetnode = $testxml->createElement('compset'); $compsetnode->setAttribute('name', $compset); } # add node children if necessary.. $testnode->addChild($newmachnode); $gridnode->addChild($testnode) if !@testnodes; $compsetnode->addChild($gridnode) if !@gridnodes; my $root = $testxml->findnodes('./testlist')->get_node(0); $root->addChild($compsetnode) if ! @compsetnodes; } $testxml = sortXML($testxml); print "added $acounter tests\n"; return $testxml; } #========================================================================== # Sort the xml entries. Drill down to the machine element, sort the machine elements # by machine name, testtype, then compiler. Then sort the tests, then the grids, # finally the compsets. # # NOTE(wjs, 2014-11-12): Could we replace this with uses of sortCESMTests, to # avoid needing to maintain this relatively complex routine? # ========================================================================== sub sortXML { my ($testxml) = shift; foreach my $compset($testxml->findnodes('/testlist/compset')) { foreach my $grid($compset->findnodes('./grid')) { foreach my $test($grid->findnodes('./test')) { #sort the machines nodes by machine, then by test type, then by #compiler. my @machnodes = $test->findnodes('./machine'); my @sortedMachNodes = sort { $a->textContent() cmp $b->textContent() || $a->getAttribute('testtype') cmp $b->getAttribute('testtype') || $a->getAttribute('compiler') cmp $b->getAttribute('compiler') } @machnodes; # remove the unsorted nodes, and re-add the sorted nodes.. $test->removeChildNodes(); map { $test->addChild($_) } @sortedMachNodes; } # sort the test nodes by name, remove the unsorted test nodes, # re-add the sorted test nodes. my @testnodes = $grid->findnodes('./test'); my @sortedTestNodes = sort { $a->getAttribute('name') cmp $b->getAttribute('name') } @testnodes; $grid->removeChildNodes(); map { $grid->addChild($_) } @sortedTestNodes; } # sort the grid nodes by name, remove the unsorted, then # add the sorted. my @gridnodes = $compset->findnodes('./grid'); my @sortedGridNodes = sort { $a->getAttribute('name') cmp $b->getAttribute('name') } @gridnodes; $compset->removeChildNodes(); map { $compset->addChild($_) } @sortedGridNodes; } # sort the compset nodes. my @compsetnodes = $testxml->findnodes('/testlist/compset'); my @sortedCompsetNodes = sort { $a->getAttribute('name') cmp $b->getAttribute('name') } @compsetnodes; # get the root element, remove the unsorted compset nodes, # add the sorted compset nodes. my $root = $testxml->getDocumentElement(); $root->removeChildNodes(); map { $root->addChild($_) } @sortedCompsetNodes; return $testxml; } #========================================================================== # Remove xml tests if they match the compset, grid, testname, machine, compiler # test category , or testmods argument, and return the xml object. #========================================================================== sub removeXMLTests { my ($testxml, $compset, $grid, $test, $machine, $compiler, $testtype, $testmods) = @_; # drill down into the machine nodes. Move onto the next element # if anything doesn't match the compset, grid, testname... my $rcounter = 0; foreach my $compsetnode($testxml->findnodes('/testlist/compset')) { my $xcompsetname = $compsetnode->getAttribute('name'); if(defined $$compset) { next unless ($xcompsetname eq $$compset); } foreach my $gridnode($compsetnode->findnodes('./grid')) { my $xgridname = $gridnode->getAttribute('name'); if(defined $$grid) { next unless ($xgridname eq $$grid); } foreach my $testnode($gridnode->findnodes('./test')) { my $xtestname = $testnode->getAttribute('name'); if(defined $$test) { next unless ($xtestname eq $$test); } # get the machine node content. Skip anything that doesn't # match the machine name, compiler, test category, or testmods. foreach my $machnode($testnode->findnodes('./machine')) { my $xmachinename = $machnode->textContent(); my $xcompilername = $machnode->getAttribute('compiler'); my $xtesttypename = $machnode->getAttribute('testtype'); my $xtestmodsname = $machnode->getAttribute('testmods'); if(defined $$machine) { next unless $xmachinename eq $$machine; } if(defined $$testtype) { next unless $xtesttypename eq $$testtype; } if(defined $$compiler) { next unless $xcompilername eq $$compiler; } if(defined $$testmods) { next unless $xtestmodsname eq $$testmods; } # Remove the node if everything matched.. $testnode->removeChild($machnode); $rcounter++; } # If the current test entry doesn't have any children, # remove it. if(! $testnode->nonBlankChildNodes()) { my $parent = $testnode->parentNode(); $parent->removeChild($testnode); } } # If the current grid node doesn't have any children, # remove it. if(! $gridnode->nonBlankChildNodes()) { my $parent = $gridnode->parentNode(); $parent->removeChild($gridnode); } } # If the current compset node doesn't have any children, # remove it from the root. if(! $compsetnode->nonBlankChildNodes()) { my $parent = $compsetnode->parentNode(); $parent->removeChild($compsetnode); } } print "removed $rcounter tests\n"; return $testxml; } #========================================================================== # Query the relevant file for the available compsets, grids, tests, machines, # and compilers. #========================================================================== sub list { my $listopt = $opts{'list'}; my $testxml = readXML(); my @list; my %uniqs; if($listopt =~ /compsets/) { print "$banner\nAvailable compsets\n$banner\n"; foreach my $elem($testxml->findnodes('//compset')) { my $val = $elem->getAttribute('name'); push(@list, $val); } map { $uniqs{$_} = 1} @list; @list = keys %uniqs; map { print " $_ \n"} sort @list; } if($listopt =~ /grids/) { print "$banner\nAvailable grids\n$banner\n"; foreach my $elem($testxml->findnodes('//grid')) { my $val = $elem->getAttribute('name'); push(@list, $val); } map { $uniqs{$_} = 1} @list; @list = keys %uniqs; map { print " $_ \n"} sort @list; } if($listopt =~ /machines/) { print "$banner\nAvailable machines\n$banner\n"; foreach my $elem($testxml->findnodes('//machine')) { my $val = $elem->textContent; push(@list, $val); } map { $uniqs{$_} = 1} @list; @list = keys %uniqs; map { print " $_ \n"} sort @list; } if($listopt =~ /categories/) { print "$banner\nAvailable test categories\n$banner\n"; foreach my $elem($testxml->findnodes('//machine')) { my $val = $elem->getAttribute('testtype'); push(@list, $val); } map { $uniqs{$_} = 1} @list; @list = keys %uniqs; map { print " $_ \n"} sort @list; } if($listopt =~ /tests/) { print "$banner\nAvailable Tests\n$banner\n"; my $testconfig = XML::LibXML->new()->parse_file("./ccsm_utils/Testcases/config_tests.xml"); my $testroot = $testconfig->getDocumentElement(); foreach my $elem($testroot->findnodes('//ccsmtest')) { my $name = $elem->getAttribute('NAME'); my $desc = $elem->getAttribute('DESC'); my $val = "$name ($desc)"; push(@list, $val); } map { $uniqs{$_} = 1} @list; @list = keys %uniqs; map { print " $_ \n"} sort @list; print << 'EOF'; The following modifiers can be used in the test name _CG = gregorian calendar _D = debug _E = esmf interfaces _IOP*= PnetCDF IO test where * is A(atm), C(cpl), G(glc) , I(ice), L(clm), O(ocn), W(wav) or blank (all components) _L* = set run length y, m, d, h, s, n(nsteps) plus integer (ie _Lm6 for 6 months) _M* = set the mpilib to *, where * is default, mpi-serial, mpich, etc _N* = set NINST_ env value to *, where * is an integer _P* = set pecount to *, where * are specific values which include T,S,M,L,X,1,1x1,16,16x1,4x4, etc _R* = PTS_MODE test case, valid values are LA, LB, OA, OB EOF print " \n"; } if($listopt =~ /compilers/) { print "$banner\nAvailable compilers\n$banner\n"; foreach my $elem($testxml->findnodes('//machine')) { my $compiler = $elem->getAttribute('compiler'); push(@list, $compiler); } map { $uniqs{$_} = 1} @list; @list = keys %uniqs; map { print " $_\n"} sort @list; } } #========================================================================== # query the test xml file by compset, grid, test, machine, compiler, # test category, testmods, or any combination thereof. Just use the testxml # object read in from testlist.xml, remove any xml elements that don't match, # and return the testxml object with only the nodes matching the query. #========================================================================== sub queryXMLTests { my ($testxml, $compset, $grid, $test, $machine, $compiler, $testtype, $testmods) = @_; # drill down into the machine nodes. Move onto the next element # if anything doesn't match the compset, grid, testname... my $root = $testxml->getDocumentElement(); foreach my $compsetnode($testxml->findnodes('/testlist/compset')) { my $xcompsetname = $compsetnode->getAttribute('name'); if(defined $$compset && $$compset ne $xcompsetname) { $root->removeChild($compsetnode); next; } foreach my $gridnode($compsetnode->findnodes('./grid')) { my $xgridname = $gridnode->getAttribute('name'); if(defined $$grid && $$grid ne $xgridname) { $compsetnode->removeChild($gridnode); next; } foreach my $testnode($gridnode->findnodes('./test')) { my $xtestname = $testnode->getAttribute('name'); if(defined $$test && $$test ne $xtestname) { $gridnode->removeChild($testnode); next; } foreach my $machnode($testnode->findnodes('./machine')) { my $xmachinename = $machnode->textContent(); my $xcompilername = $machnode->getAttribute('compiler'); my $xtesttypename = $machnode->getAttribute('testtype'); my $xtestmodsname = $machnode->getAttribute('testmods'); if(defined $$machine && $$machine ne $xmachinename) { $testnode->removeChild($machnode); next; } if(defined $$compiler && $$compiler ne $xcompilername) { $testnode->removeChild($machnode); next; } if(defined $$testtype && $$testtype ne $xtesttypename) { $testnode->removeChild($machnode); next; } if(defined $$testmods && $$testmods ne $xtestmodsname) { $testnode->removeChild($machnode); next; } } if(! $testnode->nonBlankChildNodes()) { $gridnode->removeChild($testnode); } } if(! $gridnode->nonBlankChildNodes()) { $compsetnode->removeChild($gridnode); } } if(! $compsetnode->nonBlankChildNodes()) { $root->removeChild($compsetnode); } } return $testxml; } #========================================================================== # Query subroutine called from main. Read the xml file, query the object, # and print the user's choice of output. #========================================================================== sub query { my $testxml = readXML(); $testxml = queryXMLTests($testxml, \$opts{'compset'}, \$opts{'grid'}, \$opts{'test'}, \$opts{'machine'}, \$opts{'compiler'}, \$opts{'category'}, \$opts{'testmods'}); #print $testxml->toString(1); $testxml = sortXML($testxml); if($opts{'outputxml'}) { print $testxml->toString(1); } elsif($opts{'outputlist'}) { textOutput($testxml); } else { formattedOutput($testxml); } } #========================================================================== # Convert an xml-based test list to a list of CESMTests # ========================================================================== sub convertXMLToCESMTests { my $testxml = shift; my @tests; foreach my $compsetnode ($testxml->findnodes('./testlist/compset')) { foreach my $gridnode ($compsetnode->findnodes('./grid')) { foreach my $testnode ($gridnode->findnodes('./test')) { foreach my $machnode ($testnode->findnodes('./machine')) { my $compset = $compsetnode->getAttribute('name'); my $grid = $gridnode->getAttribute('name'); my $testname = $testnode->getAttribute('name'); my $machine = $machnode->textContent; my $compiler = $machnode->getAttribute('compiler'); my $testtype = $machnode->getAttribute('testtype'); my $testmods = $machnode->getAttribute('testmods'); my $comment = $machnode->getAttribute('comment'); my $tst = new CESMTest(compset => $compset, grid => $grid, testname => $testname, machine => $machine, compiler => $compiler, testtype => $testtype); if (defined $testmods) { $tst->{testmods} = $testmods; } if (defined $comment) { $tst->{comment} = $comment; } push(@tests, $tst); } } } } return \@tests; } #========================================================================== # Print out the queried test list in the old-style test output. #========================================================================== sub textOutput { my $testxml = shift; #print $testxml->toString(1); my @output; my $tests = convertXMLToCESMTests($testxml); foreach my $test (@$tests) { my $compset = $test->{compset}; my $grid = $test->{grid}; my $testname = $test->{testname}; my $machine = $test->{machine}; my $compiler = $test->{compiler}; my $testmods = $test->{testmods}; my $comment = $test->{comment}; my $line = "$testname\.$grid\.$compset\.$machine\_$compiler"; if(defined $testmods) { $testmods =~ s/ //g; $testmods =~ s/\//-/g; $line .= "\.$testmods"; } if(defined $comment) { $line .= " # $comment"; } push(@output, $line); } # add a header, and the options used to create the text list. my $dtformat = strftime "%d%b%Y-%H%M%S", localtime; my $header = "# Test list created $dtformat with the following options: "; my $opt_output = "# "; $opt_output .= "-compset $opts{'compset'} " if defined $opts{'compset'}; $opt_output .= "-grid $opts{'grid'} " if defined $opts{'grid'}; $opt_output .= "-test $opts{'test'} " if defined $opts{'test'}; $opt_output .= "-compiler $opts{'compiler'} " if defined $opts{'compiler'}; $opt_output .= "-machine $opts{'machine'} " if defined $opts{'machine'}; $opt_output .= "-category $opts{'category'} " if defined $opts{'category'}; $opt_output .= "-testmods $opts{'testmods'} " if defined $opts{'testmods'}; unshift(@output, $opt_output); unshift(@output, $header); #map { print "$_\n" } sort @output; map { print "$_\n" } @output; } #========================================================================== # print out the queried test list in a (hopefully) nicely formatted fashion. #========================================================================== sub formattedOutput { my $testxml = shift; my @output; my $header = sprintf(" %-60s %-25s %-20s %-20s %-20s %-30s %-20s", "Compset", "TestName", "Grid", "Machine_compiler", "Test Category", "TestMods (optional)", "Comment(Optional)"); my %configcompsets; my $compsetxml = XML::LibXML->new()->parse_file("$scriptdir/ccsm_utils/Case.template/config_compsets.xml"); foreach my $cfgcompset ($compsetxml->findnodes('//COMPSET')) { my $alias = $cfgcompset->getAttribute('alias'); my $sname = $cfgcompset->getAttribute('sname'); $configcompsets{$alias} = $sname; } my $tests = convertXMLToCESMTests($testxml); foreach my $test (@$tests) { my $compset = $test->{compset}; my $fcompset = "$compset ($configcompsets{$compset})"; my $grid = $test->{grid}; my $testname = $test->{testname}; my $machine = $test->{machine}; my $compiler = $test->{compiler}; my $machine_compiler = $machine . "_" . $compiler; my $testtype = $test->{testtype}; my $testmods = $test->{testmods}; my $comment = $test->{comment}; #next if($line =~ /^$/); my $line = sprintf(" %-60s %-25s %-20s %-20s %-20s %-30s %-20s", $fcompset, $testname, $grid, $machine_compiler, $testtype, $testmods, $comment); push(@output, $line); } my @sortedoutput = sort @output; unshift(@sortedoutput, $header); map { print "$_\n" } @sortedoutput; } #========================================================================== # Add the tests. Parse the text file, read the xml, add the xml tests. # Write the new xml file. #========================================================================== sub addTests { my $tests = parseTextList($opts{'file'}); # parseTextList will return undef if there is a parsing problem... exit(1) if(! defined $tests); my $testxml = readXML(); $testxml = addXMLTests($tests, $testxml, \$opts{'category'}); writeXML($testxml); } #========================================================================== # Sync an existing test list. Read testlist.xml, remove the tests matching the # options (must be the same options used to dump the test list, parse the changed # text test list, add the changes back to the xml object, and write a new file. #========================================================================== sub syncTests { my $tests = parseTextList($opts{'file'}); # parseTextList will return undef if there is a parsing problem... exit(1) if(! defined $tests); my $testxml = readXML(); $testxml = removeXMLTests($testxml, \$opts{'compset'}, \$opts{'grid'}, \$opts{'test'}, \$opts{'machine'}, \$opts{'compiler'}, \$opts{'category'}, \$opts{'testmods'}); $testxml = addXMLTests($tests, $testxml, \$opts{'category'}); writeXML($testxml); } #========================================================================== # Remove tests from testlist.xml. Tests can be removed using compset, grid, test name, # machine, compiler, testmods, or any combination thereof. #========================================================================== sub removeTests { my $testxml = readXML(); $testxml = removeXMLTests($testxml, \$opts{'compset'}, \$opts{'grid'}, \$opts{'test'}, \$opts{'machine'}, \$opts{'compiler'}, \$opts{'category'}, \$opts{'testmods'}); $testxml = sortXML($testxml); writeXML($testxml); } #========================================================================== # Clean testlist.xml, and write out the new file. # # This procedure results in a sorted file with duplicate nodes consolidated, and # duplicate entries removed. #========================================================================== sub cleanTestlistXMLFile { my $testxml = readXML(); my $testxml_cleaned = cleanTestlistXML($testxml); writeXML($testxml_cleaned); } #========================================================================== # Determine testlist for target component #========================================================================== sub setTestlist{ my $comp = shift; my $list; if ($comp =~ /^cam/ ) { $list = "$ccsmroot/components/cam/cesmtest/testlist_cam.xml"; } elsif ($comp =~ /^allactive/) { $list = "$scriptdir/ccsm_utils/Testlistxml/testlist_allactive.xml"; } elsif ($comp =~ /^clm/) { $list = "$ccsmroot/components/clm/cesmtest/testlist_clm.xml"; } elsif ($comp =~ /^cice/) { $list = "$ccsmroot/components/cice/cesmtest/testlist_cice.xml"; } elsif ($comp =~ /^drv/) { $list = "$ccsmroot/cime/driver_cpl/cesmtest/testlist_drv.xml"; } elsif ($comp =~ /^cism/) { $list = "$ccsmroot/components/cism/cesmtest/testlist_cism.xml"; } elsif ($comp =~ /^pop/) { $list = "$ccsmroot/components/pop2/cesmtest/testlist_pop.xml"; } else { die "component $comp does not match supported components \n"; } print "# testlist is $list \n"; return $list; } #========================================================================== # Clean a testlist xml object, and return the cleaned object # # This procedure sorts the xml, consolidates duplicate notes, and removes # duplicate entries #========================================================================== sub cleanTestlistXML { my $testxml = shift; my $cesm_tests = convertXMLToCESMTests($testxml); my $testxml_cleaned = addXMLTests($cesm_tests, blankXML()); return $testxml_cleaned; } sub main { getOptions(); if(defined $opts{'removetests'}) { print "removing tests..\n"; removeTests(); } elsif(defined $opts{'addlist'}) { print "\n Adding tests...\n"; addTests(\$opts{'file'}, \$opts{'category'}); } elsif(defined $opts{'synclist'}) { print "\n Syncing changes to test list..\n"; syncTests(); } elsif(defined $opts{'cleanxml'}) { print "\n Cleaning the xml test list...\n"; cleanTestlistXMLFile(); } elsif(defined $opts{'list'}) { list(); } elsif(defined $opts{'query'}) { query(); } } main(@ARGV) unless caller;