[cig-commits] commit: Remove useless stuff from the top directory
Mercurial
hg at geodynamics.org
Thu Apr 1 08:40:01 PDT 2010
changeset: 275:8fb4d7491dd4
user: Walter Landry <wlandry at caltech.edu>
date: Thu Apr 01 07:07:42 2010 -0700
files: ChangeLog XMLChanges_1.4 bittenObtain.py fast-scons.sh identify-all.sh obtainRepositories.py pull+update-all.sh script/checkpointTest-noStokes.pl script/checkpointTest-withConstant.pl script/checkpointTest.pl script/dist.py script/dist.pyc script/macroanalyze/createtables.sh script/macroanalyze/doominc.pl script/macroanalyze/doomstr.pl script/macroanalyze/getdefargs.pl script/macroanalyze/getstructs.pl script/macroanalyze/lineage.pl script/macroanalyze/proto.pl script/macroanalyze/readdefarg.pl script/macroanalyze/readme.txt script/macroanalyze/readstruct.pl script/macroanalyze/rungetdefs.sh script/macroanalyze/rungetstructs.sh script/macroanalyze/runproto.sh script/restartTest.pl script/systest.pl updateRepos.py
description:
Remove useless stuff from the top directory
diff -r f14bcac1cb23 -r 8fb4d7491dd4 ChangeLog
--- a/ChangeLog Tue Mar 23 08:15:25 2010 -0700
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,13 +0,0 @@
-ChangeLog for Underworld-1.4
-
-* New configuration step in installation process, './configure.py -h' for help.
-* Changes to the XML user interface, see the file XMLChanges_1.4 for details.
-* Multigrid solver is now available.
-* Superconvergent Patch Recovery (SPR) Method is now available.
-* Significant checkpointing improvements, hdf5 format is now the standard format, see manual for details.
-* Testing have been enabled. Currently 443 unit tests + 105 system tests.
-Automatic testing is run periodically on multiple platforms with Shinkou
-system, see https://www.mcc.monash.edu.au/trac/test/build.
-* New constructor/destroy/delete phases for all components and plugins.
-* Toolboxes / Context code tangle has been addressed.
-* Bugfixes and memory cleaning changes also.
diff -r f14bcac1cb23 -r 8fb4d7491dd4 XMLChanges_1.4
--- a/XMLChanges_1.4 Tue Mar 23 08:15:25 2010 -0700
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,84 +0,0 @@
-XML Input File changes for Underworld 1.4
-==============================================
-
-
-===================================================
-1. User must specify the âcontextâ of the model
-===================================================
-This must be done first before other components are read into the dictionary, otherwise the simulation will halt in it's 'read from input file' phase. To perform this add:
-
-<struct name=âcomponentsâ mergeType=âmergeâ>
- <struct name=âcontextâ>
- <param name=âTypeâ>UnderworldContext</param>
- </struct>
-</struct>
-
-We recommend this be included directly after <list name=âimportâ>...</list>
-
-===================================================
-2. Plugins are now defined in XML as components are
-===================================================
-
-To general syntax for adding a plugin is now:
- <list name="plugins" mergeType="merge">
- <struct>
- <param name="Type">PlugingName</param>
- <param name="Context">context</param>
- ...
- </struct>
- </list>
-where the '...' represents arguments to pass into the plugin.
-
-So what was, as of Underworld 1.2
- <list name="plugins" mergeType="merge">
- <!-- Output Plugins -->
- <param>StgFEM_FrequentOutput</param>
- <param>Underworld_Vrms</param>
- <param>StgFEM_CPUTime</param>
- </list>
-
-Is now:
- <list name="plugins" mergeType="merge">
- <struct>
- <param name="Type">StgFEM_FrequentOutput</param>
- <param name="Context">context</param>
- </struct>
- <struct>
- <param name="Type">Underworld_Vrms</param>
- <param name="Context">context</param>
- <param name="GaussSwarm">gaussSwarm</param>
- <param name="VelocityField">VelocityField</param>
- </struct>
- <struct>
- <param name="Type">StgFEM_CPUTime</param>
- <param name="Context">context</param>
- </struct>
- </list>
-
-This adds verbosity to the plugins and requires the user to know what parameters to pass to a plugin. As with the âComponentsâ, parameters passed in are error checked and the code will halt and report a problem if invalid parameters are found. This change is necessary for the code restructure of late 2009.
-
-==============================================
-3. Verticies ---- > Vertices
-==============================================
-The code now uses the correct spelling 'vertices' to define a list containing multiple vertex points. The previous, incorrect spelling was 'verticies'. Please check that your Shape definitions are consistent with this.
-
-==============================================
-4. Declaring gLucifer
-==============================================
-If creating gLucifer visualisation and NOT including the template <include>glucifer/window.xml</include>, one must define
-
-<param name=âlucPluginContextâ>context</param>
-<list name=âpluginsâ mergeType=âmergeâ>
- <struct>
- <param name=âTypeâ>lucPlugin</param>
- <param name=âContextâ>lucPluginContext</param>
- </struct>
-</list>
-
-(see the file gLucifer/ModelComponents/window.xml as an example)
-
-
-See any .xml in the Underworld/InputFiles/ for examples of these changes.
-
-
-
diff -r f14bcac1cb23 -r 8fb4d7491dd4 bittenObtain.py
--- a/bittenObtain.py Tue Mar 23 08:15:25 2010 -0700
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,90 +0,0 @@
-#!/usr/bin/env python
-
-from mercurial import hg, ui, util
-import urllib2
-import ConfigParser
-import os, errno
-import sys
-
-# hacky way to find out what the name of the branch is
-branch = os.popen('hg branch').readlines()
-branch = branch[0].replace("\n","")
-cwd = os.getcwd()
-
-if len(sys.argv) > 1:
- deps = [ \
- ['https://' + (sys.argv[1] + '@') + 'csd.vpac.org/hg/hgforest', '.hg/forest' ], \
- ['https://' + (sys.argv[1] + '@') + 'csd.vpac.org/hg/SConfigure', 'config' ], \
- ['https://' + (sys.argv[1] + '@') + 'www.mcc.monash.edu.au/hg/gLucifer', 'gLucifer' ], \
- ['https://' + (sys.argv[1] + '@') + 'csd.vpac.org/hg/PICellerator', 'PICellerator' ], \
- ['https://' + (sys.argv[1] + '@') + 'csd.vpac.org/hg/StgDomain', 'StgDomain' ], \
- ['https://' + (sys.argv[1] + '@') + 'csd.vpac.org/hg/StGermain', 'StGermain' ], \
- ['https://' + (sys.argv[1] + '@') + 'csd.vpac.org/hg/StgFEM', 'StgFEM' ], \
- ['https://' + (sys.argv[1] + '@') + 'www.mcc.monash.edu.au/hg/Underworld', 'Underworld' ], \
- ['https://' + (sys.argv[1] + '@') + 'www.mcc.monash.edu.au/hg/Experimental', 'Experimental' ], \
- ['https://' + (sys.argv[1] + '@') + 'csd.vpac.org/hg/SConfigure', 'Experimental/PDERework/config' ], \
- ['https://' + (sys.argv[1] + '@') + 'csd.vpac.org/hg/SConfigure', 'Experimental/Magma/config' ], \
- ['https://' + (sys.argv[1] + '@') + 'csd.vpac.org/hg/SConfigure', 'Experimental/Geothermal/config' ] ]
-else:
- deps = [ \
- ['https://csd.vpac.org/hg/hgforest', '.hg/forest' ], \
- ['https://csd.vpac.org/hg/SConfigure', 'config' ], \
- ['https://www.mcc.monash.edu.au/hg/gLucifer', 'gLucifer' ], \
- ['https://csd.vpac.org/hg/PICellerator', 'PICellerator' ], \
- ['https://csd.vpac.org/hg/StgDomain', 'StgDomain' ], \
- ['https://csd.vpac.org/hg/StGermain', 'StGermain' ], \
- ['https://csd.vpac.org/hg/StgFEM', 'StgFEM' ], \
- ['https://www.mcc.monash.edu.au/hg/Underworld', 'Underworld' ], \
- ['https://www.mcc.monash.edu.au/hg/Experimental', 'Experimental' ], \
- ['https://csd.vpac.org/hg/SConfigure', 'Experimental/PDERework/config' ], \
- ['https://csd.vpac.org/hg/SConfigure', 'Experimental/Magma/config' ], \
- ['https://csd.vpac.org/hg/SConfigure', 'Experimental/Geothermal/config' ] ]
-
-
-# Make sure the '.hg' directory exists
-try:
- os.mkdir('.hg')
-except OSError, e:
- if( e.errno != errno.EEXIST ):
- raise OSError( e ) # if the error is the directory exists already, keep going
-
-
-# Download the dependancies...
-u = ui.ui()
-for dep in deps:
- os.chdir(cwd)
- try:
- hg.clone( u, dep[0], dep[1], '--quiet' );
- except util.Abort, e:
- c = ConfigParser.ConfigParser()
- try:
- c.readfp( open( dep[1] + '/.hg/hgrc', 'r' ) )
- if( c.get( 'paths', 'default' ) != dep[0] ):
- print 'Creation failed - ', e, ' but points to another repository'
- else:
- print dep[1], 'already present'
- except:
- print 'Creation failed - ', e, ' and does not seem to be a valid repository'
- except urllib2.URLError, e:
- print 'Download failed - ', e
-
- # and heres some more hackyness to get hg to switch branches
- # I couldn't find any functionality to do this in the python bindings.
- # JS - 12/11/2008
- os.chdir(dep[1])
- try:
- os.system("hg up -C "+branch)
- except:
- print "fail"
-
-# Tell this root repository that its has forest
-os.chdir(cwd)
-c=ConfigParser.ConfigParser()
-c.read('.hg/hgrc')
-try:
- c.add_section('extensions')
-except ConfigParser.DuplicateSectionError:
- pass # If the error is that it exists already, keep going
-c.set( 'extensions', 'hgext.forest', os.getcwd() + '/.hg/forest/forest.py' )
-c.write( open( '.hg/hgrc', 'w' ) )
-
diff -r f14bcac1cb23 -r 8fb4d7491dd4 fast-scons.sh
--- a/fast-scons.sh Tue Mar 23 08:15:25 2010 -0700
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,2 +0,0 @@
-#!/bin/sh
-scons --max-drift=1 --implicit-deps-unchanged $*
diff -r f14bcac1cb23 -r 8fb4d7491dd4 identify-all.sh
--- a/identify-all.sh Tue Mar 23 08:15:25 2010 -0700
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,18 +0,0 @@
-#!/bin/bash
-#Run mercurial identify on all repos
-#Usage: ./identify-all.sh
-
-#Process current dir and first level of subdirs excluding .hg
-wd=`pwd`
-for f in `find . -maxdepth 1 -type d \( ! -iname ".hg" \) | sort -f`
-do
- #skip if no .hg folder
- ls $f/.hg &> /dev/null
- if [ "${?}" -ne "0" ]; then
- continue
- fi
-
- cd $f
- echo "`hg identify` $f"
- cd $wd
-done
diff -r f14bcac1cb23 -r 8fb4d7491dd4 obtainRepositories.py
--- a/obtainRepositories.py Tue Mar 23 08:15:25 2010 -0700
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,74 +0,0 @@
-#!/usr/bin/env python
-
-from mercurial import hg, ui, util
-import urllib2
-import ConfigParser
-import os, errno, sys
-
-# hacky way to find out what the name of the branch is
-branch = os.popen('hg branch').readlines()
-branch = branch[0].replace("\n","")
-cwd = os.getcwd()
-
-deps = [ \
- ['https://csd.vpac.org/hg/hgforest', '.hg/forest' ], \
- ['https://csd.vpac.org/hg/SConfigure/trunk', 'config' ], \
- ['https://www.mcc.monash.edu.au/hg/gLucifer', 'gLucifer' ], \
- ['https://csd.vpac.org/hg/PICellerator', 'PICellerator' ], \
- ['https://csd.vpac.org/hg/StgDomain', 'StgDomain' ], \
- ['https://csd.vpac.org/hg/StGermain', 'StGermain' ], \
- ['https://csd.vpac.org/hg/StgFEM', 'StgFEM' ], \
- ['https://www.mcc.monash.edu.au/hg/Underworld', 'Underworld' ] ]
-
-# Check for run time flags
-if( len(sys.argv) > 1 and sys.argv[1] == "--with-experimental=1"):
- deps.append(['https://www.mcc.monash.edu.au/hg/Experimental', 'Experimental']);
-
-# Make sure the '.hg' directory exists
-try:
- os.mkdir('.hg')
-except OSError, e:
- if( e.errno != errno.EEXIST ):
- raise OSError( e ) # if the error is the directory exists already, keep going
-
-
-# Download the dependancies...
-u = ui.ui()
-for dep in deps:
- os.chdir(cwd)
- try:
- print dep[1], '...'
- hg.clone( u, dep[0], dep[1] );
- except util.Abort, e:
- c = ConfigParser.ConfigParser()
- try:
- c.readfp( open( dep[1] + '/.hg/hgrc', 'r' ) )
- if( c.get( 'paths', 'default' ) != dep[0] ):
- print 'Creation failed - ', e, ' but points to another repository'
- else:
- print dep[1], 'already present'
- except:
- print 'Creation failed - ', e, ' and does not seem to be a valid repository'
- except urllib2.URLError, e:
- print 'Download failed - ', e
-
- # and heres some more hackyness to get hg to switch branches
- # I couldn't find any functionality to do this in the python bindings.
- # JS - 12/11/2008
- os.chdir(dep[1])
- try:
- os.system("hg up -C "+branch)
- except:
- print "fail"
-
-# Tell this root repository that its has forest
-os.chdir(cwd)
-c=ConfigParser.ConfigParser()
-c.read('.hg/hgrc')
-try:
- c.add_section('extensions')
-except ConfigParser.DuplicateSectionError:
- pass # If the error is that it exists already, keep going
-c.set( 'extensions', 'hgext.forest', os.getcwd() + '/.hg/forest/forest.py' )
-c.write( open( '.hg/hgrc', 'w' ) )
-
diff -r f14bcac1cb23 -r 8fb4d7491dd4 pull+update-all.sh
--- a/pull+update-all.sh Tue Mar 23 08:15:25 2010 -0700
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,63 +0,0 @@
-#!/bin/bash
-#Run mercurial pull and update in all directories
-#Usage: ./pull+update-all.sh [username]
-#Prompts for password
-
-check-errs()
-{
- # Function. Parameter 1 is the return code
- # Para. 2 is text to display on failure.
- if [ "${1}" -ne "0" ]; then
- echo "ERROR # ${1} : ${2}"
- exit ${1}
- fi
-}
-
-#check for username provided in hg paths url (look for @ symbol)
-#if present don't rewrite repository urls with username/pass
-expr match "`hg paths`" '.*\(@\).*' &> /dev/null
-if [ "${?}" -ne "0" ]; then
- #get username from command line argument, defaults to current user
- if [ $# -ne 1 ]
- then
- echo "Using currently logged in user name: `whoami`"
- user=`whoami`
- else
- user=$1
- fi
-
- #get password
- echo -n "Enter password for $user: "
- stty -echo
- read password
- stty echo
- echo ""
-
- #setup username and password
- login="https://$user:$password@"
-else
- login="https://"
-fi
-
-#Process current dir and first level of subdirs excluding .hg
-wd=`pwd`
-for f in `find . -maxdepth 1 -type d \( ! -iname ".hg" \)`
-do
- #skip if no .hg folder
- ls $f/.hg &> /dev/null
- if [ "${?}" -ne "0" ]; then
- continue
- fi
-
- cd $f
- echo "-------- Processing [ $f ] ---------------------------------------"
-
- #strip start of hg paths output to get repository name
- paths=`hg paths | sed 's/default = https:\/\///'`
-
- hg pull $login$paths
- check-errs $? "hg pull failed"
- hg update
- check-errs $? "hg update failed"
- cd $wd
-done
diff -r f14bcac1cb23 -r 8fb4d7491dd4 script/checkpointTest-noStokes.pl
--- a/script/checkpointTest-noStokes.pl Tue Mar 23 08:15:25 2010 -0700
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,388 +0,0 @@
-#!/usr/bin/perl -w
-#
-use strict;
-
-##### SUBROUTINES #####
-sub runTests;
-sub executeCommandline;
-sub testConvergence;
-sub generateConvergence;
-sub testNumbersAgainstExpected;
-sub readOptionsFile;
-
-
-##### GLOBAL VARS #####
-our $testReport = "[Bitten] purpose=test current numerical fields against previously checkpoint fields of this model\n";
-our $cvgFileName = "";
-our $helpStr = "To run checkpoint tests:
-
-./checkpointTest.pl <xmlFile> [ OPTIONS ]
-
-where OPTIONS:
- -optionsFile <fileName> : where <fileName> is the options file. Command line agruments in StGermain format.
- -c : will \"create\" checkpointed data only. By default this flag in not set and the script only checks against previous checkpointed data.
- -n <#> : the timestep checkpoint writing (if -c is defined) or checkpoint testing will occur on. By default this is timestep 10.
- -np <#> : the number of processors to run. (This value will overwrite the number of preocessors given in the optionsFile
- -serial : will execute test without any mpi binary prefix. (Overwrites \"-np\" option).
- -h : this help message
-
-Also the environment variable \$UNDERWORLD_MPI can be set to specify the mpi binary to be used
-
-EXAMPLE:
- ./checkpointTest.pl testVelicSolS.xml -optionsFile OFile.dat
- (Runs with option file OFile.dat and checks against the expected file)
-
-";
-
-###### MAIN PROGRAM ######
-
-# 1) Run the xml
-$cvgFileName = &runTests();
-
-# 2) Check against expected, checkpoint files
-exit &testConvergence( $cvgFileName );
-
-###### END MAIN ######
-
-
-sub runTests {
- my $res;
- my $command;
- my $createTest=0; #boolean to create an expected file, defaut 0
-
- # read commandline args
- my $arg;
- my $ii = 0;
- my $xmlFile = " ";
- my $optFile = " ";
- my $numberOfTimeSteps = 10; # testing Timestep is 10 by default
- my @procs = (1,1,1,1);
- my @commandLines = ""; #("--elementResI=32 --elementResJ=32 " );
- my $outputPath = " ";
- my $nProcs = -1;
- my $isSerial = 0;
- my $mpiBin = $ENV{'UNDERWORLD_MPI'};
-
- # check if xml exists and options file is specified
- for( $ii = 0; $ii < scalar(@ARGV); $ii++ ) {
- $arg = $ARGV[$ii];
- if( $arg =~ m/.*\.xml$/ ) { $xmlFile = $arg; }
- elsif( $arg =~ m/\-optionsFile/ ) { $optFile = $ARGV[$ii+1]; $ii++; }
- elsif( $arg =~ m/^\-h$/ ) { print $helpStr; exit }
- elsif( $arg =~ m/^\-\-help$/ ) { print $helpStr; exit }
- elsif( $arg =~ m/^\-c/ ) { $createTest=1; }
- elsif( $arg =~ m/^\-n/ ) { $numberOfTimeSteps=$ARGV[$ii+1]; $ii++; }
- elsif( $arg =~ m/^\-np/ ) { $nProcs=$ARGV[$ii+1]; $ii++; }
- elsif( $arg =~ m/^\-serial/ ) { $isSerial=1; }
- }
- if( $xmlFile eq " " ) { die "\n\n### ERROR ###\nNo xml file specified, stopped" ; }
- if( !(-e $xmlFile) ) { die "\n\n### ERROR ###\nCannot find input file: $xmlFile, stopped" ; }
-
- # check if options file is given, otherwise run default
- if( $optFile ne " " ) {
- if( !(-e $optFile) ) { die "\\n### ERROR ###\nnCannot find run options file $optFile, stopped"; }
-
- # read in run options file
- &readOptionsFile( $optFile, \@procs, \@commandLines );
- }
-
- # if commandline option np is valid use it
- if( $nProcs > 0 ) { $procs[0] = $nProcs; }
- if( $isSerial ) { $procs[0] = 1; }
-
- if( $optFile ne " " ) {
- print "\nUsing options file $optFile, specifed options are:\n-n $procs[0] "; foreach (@commandLines) { print "$_ "; }
- }
-
- my $exec = "udw"; # executable name
- my $stdout;
- my $stderr;
-
- # create strings for 1) creating checkpoint data & 2) testing against checkpointed data
- my $xmlSegmentCreateTest = "<StGermainData xmlns=\"http://www.vpac.org/StGermain/XML_IO_Handler/Jun2003\">
- <param name=\"checkpointEvery\" mergeType=\"replace\">10</param>
- <param name=\"outputPath\" mergeType=\"replace\">./expected/$xmlFile</param>
- <param name=\"maxTimeSteps\" mergeType=\"replace\">$numberOfTimeSteps</param>
- <param name=\"dumpEvery\" mergeType=\"replace\">0</param>
-</StGermainData>";
- my $xmlSegmentToTest = "<StGermainData xmlns=\"http://www.vpac.org/StGermain/XML_IO_Handler/Jun2003\">
- <struct name=\"components\" mergeType=\"merge\">
- <struct name=\"tester\">
- <param name=\"Type\">FieldTest</param>
- </struct>
- </struct>
-
- <param name=\"outputPath\" mergeType=\"replace\">./output/$xmlFile</param>
- <param name=\"checkpointEvery\" mergeType=\"replace\">0</param>
- <param name=\"dumpEvery\" mergeType=\"replace\">0</param>
- <param name=\"maxTimeSteps\" mergeType=\"replace\">$numberOfTimeSteps</param>
- <struct name=\"pluginData\" mergeType=\"replace\">
- <list name=\"NumericFields\">
- <param>VelocityField</param> <param>0</param>
- <param>TemperatureField</param> <param>2</param>
- </list>
- <param name=\"IntegrationSwarm\">gaussSwarm</param>
- <param name=\"ConstantMesh\">constantMesh</param>
- <param name=\"testTimestep\">$numberOfTimeSteps</param>
- <param name=\"ElementMesh\">linearMesh</param>
- <param name=\"normaliseByAnalyticSolution\">True</param>
- <param name=\"context\">context</param>
- <param name=\"appendToAnalysisFile\">True</param>
- <!-- reference soln stuff -->
- <param name=\"useReferenceSolutionFromFile\">true</param>
- <param name=\"referenceSolutionFilePath\">./expected/$xmlFile</param>
- <list name=\"ReferenceFields\">
- <param>VelocityField</param>
- <param>TemperatureField</param>
- </list>
- </struct>
-</StGermainData>";
-
- # Need to check for an executable
- if( !(-e "./../../../build/bin/StGermain" ) ) {
- die "\n\n### ERROR ###\nCan't find ./../../../build/bin/StGermain - the executable which runs the test, stopped";
- }
-
- if( $createTest ) {
- print "\n--- Creating checkpoint files for $xmlFile at timestep $numberOfTimeSteps---\n";
- } else {
- print "\n--- Testing the $xmlFile ---\n";
- }
-
- # is the symbolic link there, if not create it
- if( !(-e $exec) ) {
- $command = "ln -s ../../../build/bin/StGermain $exec";
- print "\n$command\n\n";
- &executeCommandline( $command );
- }
-
- # check if there's a log dir
- if( !(-e "log/") ) {
- $command = "mkdir log";
- &executeCommandline( $command );
- }
-
- # declare stdout and stderr files, in log dir.
- $stdout = "log/$xmlFile"."_runs.stdout";
- $stderr = "log/$xmlFile"."_runs.stderr";
-
- # remove old log file, if it exists
- if( -e "$stdout" ) {
- $command = "rm $stdout";
- &executeCommandline( $command );
- }
-
- # remove old cvg file, if it exists
- if( scalar (glob "*.cvg") ) {
- $command = "rm *.cvg";
- &executeCommandline( $command );
- }
-
- # create help.xml for setting up test
- if( $createTest ) {
- $command = "echo \'$xmlSegmentCreateTest\' > help.xml ";
- } else {
- $command = "echo \'$xmlSegmentToTest\' > help.xml ";
- }
- &executeCommandline($command);
-
- # run test case
- if( defined($mpiBin) ) { # if custom mpi is specified use it
- $command = "$mpiBin -np $procs[0] ./$exec $xmlFile help.xml $commandLines[0] --pluginData.appendToAnalysisFile=True >$stdout";
- }
- if( $isSerial ) { # if the serial flag is specified don't add anything parallel
- $command = "./$exec $xmlFile help.xml $commandLines[0] --pluginData.appendToAnalysisFile=True >$stdout";
- }
- if( !defined($mpiBin) && !$isSerial ) { # by default use mpich2 standard
- $command = "mpiexec -np $procs[0] ./$exec $xmlFile help.xml $commandLines[0] --pluginData.appendToAnalysisFile=True >$stdout";
- }
- $command .= " 2>$stderr";
- print "$command";
- &executeCommandline( $command );
-
- # check error stream for error result
- open( ERROR, "<$stderr" );
- my $line;
- foreach $line (<ERROR>) {
- if( $line =~ m/[E|e]rror/ ) {
- close(ERROR);
- die ("\n\n### ERROR ###\nError in runtime: see $stderr or $stdout - stopped" );
- }
- }
-
- # if no error close file and delete it
- close(ERROR);
- $command = "rm $stderr"; &executeCommandline($command);
-
- # removing help.xml
- $command = "rm help.xml";
- print "\n$command\n"; &executeCommandline($command);
-
- # removing softlink
- $command = "rm $exec";
- print "$command\n"; &executeCommandline($command);
-
- print "--- Finished ---\n\n";
-
- # if we're only creating checkpoint file, end program here
- if( $createTest ) { exit(0); }
-
- $testReport .= "[Bitten] proc=$procs[0]\n";
-
- #search for resolution to report
- my $resx;
- my $resy;
- my $resz;
- open( FLATOUTPUT, "./output/$xmlFile/input.xml" )
- or die ("\n\n### ERROR ###\n\t\tCouldn't open output file, ./output/$xmlFile/input.xml " );
-
- my $resolution;
- foreach $line (<FLATOUTPUT>) {
- if( $line =~ m/\"elementResI\">(\d+)</ ) { $resx = $1; }
- elsif( $line =~ m/\"elementResJ\">(\d+)</ ) { $resy = $1; }
- elsif( $line =~ m/\"elementResK\">(\d+)</ ) { $resz = $1; }
- }
- close( FLATOUTPUT );
-
- #get the total CPU time from plugin
- my @labels;
- my $label;
- my $totalTime;
- my $freqOutput = "./output/$xmlFile/FrequentOutput.dat";
-
- if( !(-e $freqOutput) ) {
- die("\n\n### ERROR ###\nCouldn't open $freqOutput");
- }
- $ii = 0;
- $command = "head -n 1 $freqOutput";
-
- @labels = split( /\s+/, &executeCommandline( $command ) );
- foreach $label (@labels) {
- if( $label =~ m/CPUTime/ ) { last; }
- $ii++;
- }
- $command = "tail -n 1 $freqOutput";
- @labels = split( /\s+/, &executeCommandline( $command ) );
- $totalTime = $labels[$ii-1];
- $testReport .= "[Bitten] time=$totalTime\n";
-
- #append to report string
- $testReport .= "[Bitten] resx=$resx\n";
- $testReport .= "[Bitten] resy=$resy\n";
- if ( defined $resz ) { $testReport .= "[Bitten] resz=$resz\n"; }
- else { $testReport .= "[Bitten] resz=0\n"; }
-
- # return convergence file name
- $command = "ls *\.cvg 2>/dev/null";
- my $cvg = &executeCommandline($command);
- chomp( $cvg );
- return $cvg;
-}
-
-sub readOptionsFile {
- my ( $optFile, $procs, $commandLines ) = @_;
- my $line;
- # $line_I represents the number of tests to run
- my $line_I = 0;
- # open options file
- open OPTFILE, "<$optFile" || die "Can't open options file $optFile, stopped" ;
- foreach $line (<OPTFILE>) {
- chomp $line;
- # only process lines that start with np
- if( $line =~ m/^np\s+(\d+)\s+(.*)/ ) {
- $procs->[$line_I] = $1;
- $commandLines->[$line_I] = $2;
- $line_I++;
- } elsif( $line =~ m/^np\s+(\d+)$/ ) {
- $procs->[$line_I] = $1;
- $commandLines->[$line_I] = "";
- $line_I++;
- }
- else { next; }
- }
- return $line_I;
-}
-
-sub testConvergence {
- my $datFile = $_[0];
- my @keys;
- my $tolerance = 3e-2;
- my @errors;
- my $line;
- my $nKeys;
- my $nErrs;
- my $report;
- my $result;
- my $command;
- my $ii;
- # test convergence numbers
- open(INPUT, "<$datFile") || die "Can't open the expected file $datFile\n" ;
- while ($line = <INPUT>) {
- chomp $line;
- if ( $line =~ m/^\#Res\s.*/ ) {
- # parse for variable labels
- @keys = split (/\s+/, $line );
- }
- else {
- @errors = split(/\s+/, $line );
- }
- }
-
- # ensure the number of keys and error measures agree
- $nKeys = @keys;
- $nErrs = @errors;
-
- if( $nKeys != $nErrs ) { die "The number of keys against the number of errors in file $datFile don't agreed\n"; }
-
- $result = "Pass";
- $report = "";
-
- $testReport .= "[Bitten] tolerance=$tolerance\n";
-
- # go through all errors and check if they're within tolerance
- for( $ii = 1 ; $ii < $nKeys ; $ii++ ) {
- if( abs($errors[$ii]) > $tolerance ) {
- $result = "Fail";
- $report .= "***BAD NEWS*** ... $keys[$ii] differs by more than " . $tolerance*100 . "\% tolerance from expected file, error is $errors[$ii]\n";
- $testReport .= "[Bitten] error in $keys[$ii]=$errors[$ii]\n";
- } else {
- $report .= "pass ... $keys[$ii] within a ". $tolerance*100 ."\% relative tolerance from expected file\n";
- $testReport .= "[Bitten] error in $keys[$ii]=$errors[$ii]\n";
- }
- }
-
- close( INPUT );
-
- print "\n$report";
- print "\nResult = $result\n";
-
- $testReport .= "[Bitten] status=$result\n";
-
- # remove the used data file
- $command = "rm $datFile";
- &executeCommandline($command);
-
- open ( JERICO_FILE, "+>.jericoFile" );
- print JERICO_FILE "$testReport\n";
- close( JERICO_FILE );
-
- if( $result eq "Pass" ) {
- exit(0);
- } else {
- exit(1);
- }
-}
-
-
-sub executeCommandline {
-# pass in single string to execute on the command
- my $command = $_[0];
-
- my $output = qx{$command}; # that's the new shell's $$
- my $exitStatus = $? >> 8;
-
- # check the exit status of the command
- if( $exitStatus ne 0 ) { die "\n\n### ERROR ###\nCouldn't execute the command\n$command\n\n"; }
-
- return $output;
-}
diff -r f14bcac1cb23 -r 8fb4d7491dd4 script/checkpointTest-withConstant.pl
--- a/script/checkpointTest-withConstant.pl Tue Mar 23 08:15:25 2010 -0700
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,390 +0,0 @@
-#!/usr/bin/perl -w
-#
-use strict;
-
-##### SUBROUTINES #####
-sub runTests;
-sub executeCommandline;
-sub testConvergence;
-sub generateConvergence;
-sub testNumbersAgainstExpected;
-sub readOptionsFile;
-
-
-##### GLOBAL VARS #####
-our $testReport = "[Bitten] purpose=test current numerical fields against previously checkpoint fields of this model\n";
-our $cvgFileName = "";
-our $helpStr = "To run checkpoint tests:
-
-./checkpointTest.pl <xmlFile> [ OPTIONS ]
-
-where OPTIONS:
- -optionsFile <fileName> : where <fileName> is the options file. Command line agruments in StGermain format.
- -c : will \"create\" checkpointed data only. By default this flag in not set and the script only checks against previous checkpointed data.
- -n <#> : the timestep checkpoint writing (if -c is defined) or checkpoint testing will occur on. By default this is timestep 10.
- -np <#> : the number of processors to run. (This value will overwrite the number of preocessors given in the optionsFile
- -serial : will execute test without any mpi binary prefix. (Overwrites \"-np\" option).
- -h : this help message
-
-Also the environment variable \$UNDERWORLD_MPI can be set to specify the mpi binary to be used
-
-EXAMPLE:
- ./checkpointTest.pl testVelicSolS.xml -optionsFile OFile.dat
- (Runs with option file OFile.dat and checks against the expected file)
-
-";
-
-###### MAIN PROGRAM ######
-
-# 1) Run the xml
-$cvgFileName = &runTests();
-
-# 2) Check against expected, checkpoint files
-exit &testConvergence( $cvgFileName );
-
-###### END MAIN ######
-
-
-sub runTests {
- my $res;
- my $command;
- my $createTest=0; #boolean to create an expected file, defaut 0
-
- # read commandline args
- my $arg;
- my $ii = 0;
- my $xmlFile = " ";
- my $optFile = " ";
- my $numberOfTimeSteps = 10; # testing Timestep is 10 by default
- my @procs = (1,1,1,1);
- my @commandLines = ""; #("--elementResI=32 --elementResJ=32 " );
- my $outputPath = " ";
- my $nProcs = -1;
- my $isSerial = 0;
- my $mpiBin = $ENV{'UNDERWORLD_MPI'};
-
- # check if xml exists and options file is specified
- for( $ii = 0; $ii < scalar(@ARGV); $ii++ ) {
- $arg = $ARGV[$ii];
- if( $arg =~ m/.*\.xml$/ ) { $xmlFile = $arg; }
- elsif( $arg =~ m/\-optionsFile/ ) { $optFile = $ARGV[$ii+1]; $ii++; }
- elsif( $arg =~ m/^\-h$/ ) { print $helpStr; exit }
- elsif( $arg =~ m/^\-\-help$/ ) { print $helpStr; exit }
- elsif( $arg =~ m/^\-c/ ) { $createTest=1; }
- elsif( $arg =~ m/^\-n/ ) { $numberOfTimeSteps=$ARGV[$ii+1]; $ii++; }
- elsif( $arg =~ m/^\-np/ ) { $nProcs=$ARGV[$ii+1]; $ii++; }
- elsif( $arg =~ m/^\-serial/ ) { $isSerial=1; }
- }
- if( $xmlFile eq " " ) { die "\n\n### ERROR ###\nNo xml file specified, stopped" ; }
- if( !(-e $xmlFile) ) { die "\n\n### ERROR ###\nCannot find input file: $xmlFile, stopped" ; }
-
- # check if options file is given, otherwise run default
- if( $optFile ne " " ) {
- if( !(-e $optFile) ) { die "\\n### ERROR ###\nnCannot find run options file $optFile, stopped"; }
-
- # read in run options file
- &readOptionsFile( $optFile, \@procs, \@commandLines );
- }
-
- # if commandline option np is valid use it
- if( $nProcs > 0 ) { $procs[0] = $nProcs; }
- if( $isSerial ) { $procs[0] = 1; }
-
- if( $optFile ne " " ) {
- print "\nUsing options file $optFile, specifed options are:\n-n $procs[0] "; foreach (@commandLines) { print "$_ "; }
- }
-
- my $exec = "udw"; # executable name
- my $stdout;
- my $stderr;
-
- # create strings for 1) creating checkpoint data & 2) testing against checkpointed data
- my $xmlSegmentCreateTest = "<StGermainData xmlns=\"http://www.vpac.org/StGermain/XML_IO_Handler/Jun2003\">
- <param name=\"checkpointEvery\" mergeType=\"replace\">$numberOfTimeSteps</param>
- <param name=\"outputPath\" mergeType=\"replace\">./expected/$xmlFile</param>
- <param name=\"maxTimeSteps\" mergeType=\"replace\">$numberOfTimeSteps</param>
- <param name=\"dumpEvery\" mergeType=\"replace\">0</param>
-</StGermainData>";
- my $xmlSegmentToTest = "<StGermainData xmlns=\"http://www.vpac.org/StGermain/XML_IO_Handler/Jun2003\">
- <struct name=\"components\" mergeType=\"merge\">
- <struct name=\"tester\">
- <param name=\"Type\">FieldTest</param>
- </struct>
- </struct>
-
- <param name=\"outputPath\" mergeType=\"replace\">./output/$xmlFile</param>
- <param name=\"checkpointEvery\" mergeType=\"replace\">0</param>
- <param name=\"dumpEvery\" mergeType=\"replace\">0</param>
- <param name=\"maxTimeSteps\" mergeType=\"replace\">$numberOfTimeSteps</param>
- <include>StgFEM/ConstantMesh.xml</include>
- <struct name=\"pluginData\" mergeType=\"replace\">
- <list name=\"NumericFields\">
- <param>VelocityField</param> <param>0</param>
- <param>PressureField</param> <param>1</param>
- <param>TemperatureField</param> <param>2</param>
- </list>
- <param name=\"IntegrationSwarm\">gaussSwarm</param>
- <param name=\"ConstantMesh\">constantMesh</param>
- <param name=\"testTimestep\">$numberOfTimeSteps</param>
- <param name=\"ElementMesh\">linearMesh</param>
- <param name=\"normaliseByAnalyticSolution\">True</param>
- <param name=\"context\">context</param>
- <param name=\"appendToAnalysisFile\">True</param>
- <!-- reference soln stuff -->
- <param name=\"useReferenceSolutionFromFile\">true</param>
- <param name=\"referenceSolutionFilePath\">./expected/$xmlFile</param>
- <list name=\"ReferenceFields\">
- <param>VelocityField</param>
- <param>PressureField</param>
- <param>TemperatureField</param>
- </list>
- </struct>
-</StGermainData>";
-
- # Need to check for an executable
- if( !(-e "./../../../build/bin/StGermain" ) ) {
- die "\n\n### ERROR ###\nCan't find ./../../../build/bin/StGermain - the executable which runs the test, stopped";
- }
-
- if( $createTest ) {
- print "\n--- Creating checkpoint files for $xmlFile at timestep $numberOfTimeSteps---\n";
- } else {
- print "\n--- Testing the $xmlFile ---\n";
- }
-
- # is the symbolic link there, if not create it
- if( !(-e $exec) ) {
- $command = "ln -s ../../../build/bin/StGermain $exec";
- print "\n$command\n\n";
- &executeCommandline( $command );
- }
-
- # check if there's a log dir
- if( !(-e "log/") ) {
- $command = "mkdir log";
- &executeCommandline( $command );
- }
-
- # declare stdout and stderr files, in log dir.
- $stdout = "log/$xmlFile"."_runs.stdout";
- $stderr = "log/$xmlFile"."_runs.stderr";
-
- # remove old log file, if it exists
- if( -e "$stdout" ) {
- $command = "rm $stdout";
- &executeCommandline( $command );
- }
-
- # remove old cvg file, if it exists
- if( scalar (glob "*.cvg") ) {
- $command = "rm *.cvg";
- &executeCommandline( $command );
- }
-
- # create help.xml for setting up test
- if( $createTest ) {
- $command = "echo \'$xmlSegmentCreateTest\' > help.xml ";
- } else {
- $command = "echo \'$xmlSegmentToTest\' > help.xml ";
- }
- &executeCommandline($command);
-
- # run test case
- if( defined($mpiBin) ) { # if custom mpi is specified use it
- $command = "$mpiBin -np $procs[0] ./$exec $xmlFile help.xml $commandLines[0] --pluginData.appendToAnalysisFile=True >$stdout";
- }
- if( $isSerial ) { # if the serial flag is specified don't add anything parallel
- $command = "./$exec $xmlFile help.xml $commandLines[0] --pluginData.appendToAnalysisFile=True >$stdout";
- }
- if( !defined($mpiBin) && !$isSerial ) { # by default use mpich2 standard
- $command = "mpiexec -np $procs[0] ./$exec $xmlFile help.xml $commandLines[0] --pluginData.appendToAnalysisFile=True >$stdout";
- }
- $command .= " 2>$stderr";
- print "$command";
- &executeCommandline( $command );
-
- # check error stream for error result
- open( ERROR, "<$stderr" );
- my $line;
- foreach $line (<ERROR>) {
- if( $line =~ m/[E|e]rror/ ) {
- close(ERROR);
- die ("\n\n### ERROR ###\nError in runtime: see $stderr or $stdout - stopped" );
- }
- }
-
- # if no error close file and delete it
- close(ERROR);
- $command = "rm $stderr"; &executeCommandline($command);
-
- # removing help.xml
- $command = "rm help.xml";
- print "\n$command\n"; &executeCommandline($command);
-
- # removing softlink
- $command = "rm $exec";
- print "$command\n"; &executeCommandline($command);
-
- print "--- Finished ---\n\n";
-
- # if we're only creating checkpoint file, end program here
- if( $createTest ) { exit(0); }
-
- $testReport .= "[Bitten] proc=$procs[0]\n";
-
- #search for resolution to report
- my $resx;
- my $resy;
- my $resz;
- open( FLATOUTPUT, "./output/$xmlFile/input.xml" )
- or die ("\n\n### ERROR ###\n\t\tCouldn't open output file, ./output/$xmlFile/input.xml " );
-
- my $resolution;
- foreach $line (<FLATOUTPUT>) {
- if( $line =~ m/\"elementResI\">(\d+)</ ) { $resx = $1; }
- elsif( $line =~ m/\"elementResJ\">(\d+)</ ) { $resy = $1; }
- elsif( $line =~ m/\"elementResK\">(\d+)</ ) { $resz = $1; }
- }
- close( FLATOUTPUT );
-
- #get the total CPU time from plugin
- my @labels;
- my $label;
- my $totalTime;
- my $freqOutput = "./output/$xmlFile/FrequentOutput.dat";
-
- if( !(-e $freqOutput) ) {
- die("\n\n### ERROR ###\nCouldn't open $freqOutput");
- }
- $ii = 0;
- $command = "head -n 1 $freqOutput";
-
- @labels = split( /\s+/, &executeCommandline( $command ) );
- foreach $label (@labels) {
- if( $label =~ m/CPUTime/ ) { last; }
- $ii++;
- }
- $command = "tail -n 1 $freqOutput";
- @labels = split( /\s+/, &executeCommandline( $command ) );
- $totalTime = $labels[$ii-1];
- $testReport .= "[Bitten] time=$totalTime\n";
-
- #append to report string
- $testReport .= "[Bitten] resx=$resx\n";
- $testReport .= "[Bitten] resy=$resy\n";
- if ( defined $resz ) { $testReport .= "[Bitten] resz=$resz\n"; }
- else { $testReport .= "[Bitten] resz=0\n"; }
-
- # return convergence file name
- $command = "ls *\.cvg 2>/dev/null";
- my $cvg = &executeCommandline($command);
- chomp( $cvg );
- return $cvg;
-}
-
-sub readOptionsFile {
- my ( $optFile, $procs, $commandLines ) = @_;
- my $line;
- # $line_I represents the number of tests to run
- my $line_I = 0;
- # open options file
- open OPTFILE, "<$optFile" || die "Can't open options file $optFile, stopped" ;
- foreach $line (<OPTFILE>) {
- chomp $line;
- # only process lines that start with np
- if( $line =~ m/^np\s+(\d+)\s+(.*)/ ) {
- $procs->[$line_I] = $1;
- $commandLines->[$line_I] = $2;
- $line_I++;
- } elsif( $line =~ m/^np\s+(\d+)$/ ) {
- $procs->[$line_I] = $1;
- $commandLines->[$line_I] = "";
- $line_I++;
- } else { next; }
- }
- return $line_I;
-}
-
-sub testConvergence {
- my $datFile = $_[0];
- my @keys;
- my $tolerance = 3e-2;
- my @errors;
- my $line;
- my $nKeys;
- my $nErrs;
- my $report;
- my $result;
- my $command;
- my $ii;
- # test convergence numbers
- open(INPUT, "<$datFile") || die "Can't open the expected file $datFile\n" ;
- while ($line = <INPUT>) {
- chomp $line;
- if ( $line =~ m/^\#Res\s.*/ ) {
- # parse for variable labels
- @keys = split (/\s+/, $line );
- }
- else {
- @errors = split(/\s+/, $line );
- }
- }
-
- # ensure the number of keys and error measures agree
- $nKeys = @keys;
- $nErrs = @errors;
-
- if( $nKeys != $nErrs ) { die "The number of keys against the number of errors in file $datFile don't agreed\n"; }
-
- $result = "Pass";
- $report = "";
-
- $testReport .= "[Bitten] tolerance=$tolerance\n";
-
- # go through all errors and check if they're within tolerance
- for( $ii = 1 ; $ii < $nKeys ; $ii++ ) {
- if( abs($errors[$ii]) > $tolerance ) {
- $result = "Fail";
- $report .= "***BAD NEWS*** ... $keys[$ii] differs by more than " . $tolerance*100 . "\% tolerance from expected file, error is $errors[$ii]\n";
- $testReport .= "[Bitten] error in $keys[$ii]=$errors[$ii]\n";
- } else {
- $report .= "pass ... $keys[$ii] within a ". $tolerance*100 ."\% relative tolerance from expected file\n";
- $testReport .= "[Bitten] error in $keys[$ii]=$errors[$ii]\n";
- }
- }
-
- close( INPUT );
-
- print "\n$report";
- print "\nResult = $result\n";
-
- $testReport .= "[Bitten] status=$result\n";
-
- # remove the used data file
- $command = "rm $datFile";
- &executeCommandline($command);
-
- open ( JERICO_FILE, "+>.jericoFile" );
- print JERICO_FILE "$testReport\n";
- close( JERICO_FILE );
-
- if( $result eq "Pass" ) {
- exit(0);
- } else {
- exit(1);
- }
-}
-
-
-sub executeCommandline {
-# pass in single string to execute on the command
- my $command = $_[0];
-
- my $output = qx{$command}; # that's the new shell's $$
- my $exitStatus = $? >> 8;
-
- # check the exit status of the command
- if( $exitStatus ne 0 ) { die "\n\n### ERROR ###\nCouldn't execute the command\n$command\n\n"; }
-
- return $output;
-}
diff -r f14bcac1cb23 -r 8fb4d7491dd4 script/checkpointTest.pl
--- a/script/checkpointTest.pl Tue Mar 23 08:15:25 2010 -0700
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,385 +0,0 @@
-#!/usr/bin/perl -w
-#
-use strict;
-
-##### SUBROUTINES #####
-sub runTests;
-sub executeCommandline;
-sub testConvergence;
-sub generateConvergence;
-sub testNumbersAgainstExpected;
-sub readOptionsFile;
-
-
-##### GLOBAL VARS #####
-our $testReport = "[Bitten] purpose=test current numerical fields against previously checkpoint fields of this model\n";
-our $cvgFileName = "";
-our $helpStr = "To run checkpoint tests:
-
-./checkpointTest.pl <xmlFile> [ OPTIONS ]
-
-where OPTIONS:
- -optionsFile <fileName> : where <fileName> is the options file. Command line agruments in StGermain format.
- -c : will \"create\" checkpointed data only. By default this flag in not set and the script only checks against previous checkpointed data.
- -n <#> : the timestep checkpoint writing (if -c is defined) or checkpoint testing will occur on. By default this is timestep 10.
- -np <#> : the number of processors to run. (This value will overwrite the number of preocessors given in the optionsFile
- -serial : will execute test without any mpi binary prefix. (Overwrites \"-np\" option).
- -h : this help message
-
-Also the environment variable \$UNDERWORLD_MPI can be set to specify the mpi binary to be used
-
-EXAMPLE:
- ./checkpointTest.pl testVelicSolS.xml -optionsFile OFile.dat
- (Runs with option file OFile.dat and checks against the expected file)
-
-";
-
-###### MAIN PROGRAM ######
-
-# 1) Run the xml
-$cvgFileName = &runTests();
-
-# 2) Check against expected, checkpoint files
-exit &testConvergence( $cvgFileName );
-
-###### END MAIN ######
-
-
-sub runTests {
- my $res;
- my $command;
- my $createTest=0; #boolean to create an expected file, defaut 0
-
- # read commandline args
- my $arg;
- my $ii = 0;
- my $xmlFile = " ";
- my $optFile = " ";
- my $numberOfTimeSteps = 10; # testing Timestep is 10 by default
- my @procs = (1,1,1,1);
- my @commandLines = ""; #("--elementResI=32 --elementResJ=32 " );
- my $outputPath = " ";
- my $nProcs = -1;
- my $isSerial = 0;
- my $mpiBin = $ENV{'UNDERWORLD_MPI'};
-
- # check if xml exists and options file is specified
- for( $ii = 0; $ii < scalar(@ARGV); $ii++ ) {
- $arg = $ARGV[$ii];
- if( $arg =~ m/.*\.xml$/ ) { $xmlFile = $arg; }
- elsif( $arg =~ m/\-optionsFile/ ) { $optFile = $ARGV[$ii+1]; $ii++; }
- elsif( $arg =~ m/^\-h$/ ) { print $helpStr; exit }
- elsif( $arg =~ m/^\-\-help$/ ) { print $helpStr; exit }
- elsif( $arg =~ m/^\-c/ ) { $createTest=1; }
- elsif( $arg =~ m/^\-n/ ) { $numberOfTimeSteps=$ARGV[$ii+1]; $ii++; }
- elsif( $arg =~ m/^\-np/ ) { $nProcs=$ARGV[$ii+1]; $ii++; }
- elsif( $arg =~ m/^\-serial/ ) { $isSerial=1; }
- }
- if( $xmlFile eq " " ) { die "\n\n### ERROR ###\nNo xml file specified, stopped" ; }
- if( !(-e $xmlFile) ) { die "\n\n### ERROR ###\nCannot find input file: $xmlFile, stopped" ; }
-
- # check if options file is given, otherwise run default
- if( $optFile ne " " ) {
- if( !(-e $optFile) ) { die "\\n### ERROR ###\nnCannot find run options file $optFile, stopped"; }
-
- # read in run options file
- &readOptionsFile( $optFile, \@procs, \@commandLines );
- }
-
- # if commandline option np is valid use it
- if( $nProcs > 0 ) { $procs[0] = $nProcs; }
- if( $isSerial ) { $procs[0] = 1; }
-
- if( $optFile ne " " ) {
- print "\nUsing options file $optFile, specifed options are:\n-n $procs[0] "; foreach (@commandLines) { print "$_ "; }
- }
-
- my $exec = "udw"; # executable name
- my $stdout;
- my $stderr;
-
- # create strings for 1) creating checkpoint data & 2) testing against checkpointed data
- my $xmlSegmentCreateTest = "<StGermainData xmlns=\"http://www.vpac.org/StGermain/XML_IO_Handler/Jun2003\">
- <param name=\"checkpointEvery\" mergeType=\"replace\">10</param>
- <param name=\"outputPath\" mergeType=\"replace\">./expected/$xmlFile</param>
- <param name=\"maxTimeSteps\" mergeType=\"replace\">$numberOfTimeSteps</param>
- <param name=\"dumpEvery\" mergeType=\"replace\">0</param>
-</StGermainData>";
- my $xmlSegmentToTest = "<StGermainData xmlns=\"http://www.vpac.org/StGermain/XML_IO_Handler/Jun2003\">
- <struct name=\"components\" mergeType=\"merge\">
- <struct name=\"tester\">
- <param name=\"Type\">FieldTest</param>
- </struct>
- </struct>
-
- <param name=\"outputPath\" mergeType=\"replace\">./output/$xmlFile</param>
- <param name=\"checkpointEvery\" mergeType=\"replace\">0</param>
- <param name=\"dumpEvery\" mergeType=\"replace\">0</param>
- <param name=\"maxTimeSteps\" mergeType=\"replace\">$numberOfTimeSteps</param>
- <struct name=\"pluginData\" mergeType=\"replace\">
- <list name=\"NumericFields\">
- <param>VelocityField</param> <param>0</param>
- <param>PressureField</param> <param>1</param>
- <param>TemperatureField</param> <param>2</param>
- </list>
- <param name=\"IntegrationSwarm\">gaussSwarm</param>
- <param name=\"ConstantMesh\">constantMesh</param>
- <param name=\"testTimestep\">$numberOfTimeSteps</param>
- <param name=\"ElementMesh\">linearMesh</param>
- <param name=\"normaliseByAnalyticSolution\">True</param>
- <param name=\"context\">context</param>
- <param name=\"appendToAnalysisFile\">True</param>
- <!-- reference soln stuff -->
- <param name=\"useReferenceSolutionFromFile\">true</param>
- <param name=\"referenceSolutionFilePath\">./expected/$xmlFile</param>
- <list name=\"ReferenceFields\">
- <param>VelocityField</param>
- <param>PressureField</param>
- <param>TemperatureField</param>
- </list>
- </struct>
-</StGermainData>";
-
- # Need to check for an executable
- if( !(-e "./../../../build/bin/StGermain" ) ) {
- die "\n\n### ERROR ###\nCan't find ./../../../build/bin/StGermain - the executable which runs the test, stopped";
- }
-
- if( $createTest ) {
- print "\n--- Creating checkpoint files for $xmlFile at timestep $numberOfTimeSteps---\n";
- } else {
- print "\n--- Testing the $xmlFile ---\n";
- }
-
- # is the symbolic link there, if not create it
- if( !(-e $exec) ) {
- $command = "ln -s ../../../build/bin/StGermain $exec";
- print "\n$command\n\n";
- &executeCommandline( $command );
- }
-
- # check if there's a log dir
- if( !(-e "log/") ) {
- $command = "mkdir log";
- &executeCommandline( $command );
- }
-
- # declare stdout and stderr files, in log dir.
- $stdout = "log/$xmlFile"."_runs.stdout";
- $stderr = "log/$xmlFile"."_runs.stderr";
-
- # remove old log file, if it exists
- if( -e "$stdout" ) {
- $command = "rm $stdout";
- &executeCommandline( $command );
- }
-
- # remove old cvg file, if it exists
- if( scalar (glob "*.cvg") ) {
- $command = "rm *.cvg";
- &executeCommandline( $command );
- }
-
- # create help.xml for setting up test
- if( $createTest ) {
- $command = "echo \'$xmlSegmentCreateTest\' > help.xml ";
- } else {
- $command = "echo \'$xmlSegmentToTest\' > help.xml ";
- }
- &executeCommandline($command);
-
- # run test case
- if( defined($mpiBin) ) { # if custom mpi is specified use it
- $command = "$mpiBin -np $procs[0] ./$exec $xmlFile help.xml $commandLines[0] --pluginData.appendToAnalysisFile=True >$stdout";
- }
- if( $isSerial ) { # if the serial flag is specified don't add anything parallel
- $command = "./$exec $xmlFile help.xml $commandLines[0] --pluginData.appendToAnalysisFile=True >$stdout";
- }
- if( !defined($mpiBin) && !$isSerial ) { # by default use mpich2 standard
- $command = "mpiexec -np $procs[0] ./$exec $xmlFile help.xml $commandLines[0] --pluginData.appendToAnalysisFile=True >$stdout";
- }
- $command .= " 2>$stderr";
- print "$command";
- &executeCommandline( $command );
-
- # check error stream for error result
- open( ERROR, "<$stderr" );
- my $line;
- foreach $line (<ERROR>) {
- if( $line =~ m/[E|e]rror/ ) {
- close(ERROR);
- die ("\n\n### ERROR ###\nError in runtime: see $stderr or $stdout - stopped" );
- }
- }
-
- # if no error close file and delete it
- close(ERROR);
- $command = "rm $stderr"; &executeCommandline($command);
-
- # removing help.xml
- $command = "rm help.xml";
- print "\n$command\n"; &executeCommandline($command);
-
- # removing softlink
- $command = "rm $exec";
- print "$command\n"; &executeCommandline($command);
-
- print "--- Finished ---\n\n";
-
- # if we're only creating checkpoint file, end program here
- if( $createTest ) { exit(0); }
-
- $testReport .= "[Bitten] proc=$procs[0]\n";
-
- #search for resolution to report
- my $resx;
- my $resy;
- my $resz;
- open( FLATOUTPUT, "./output/$xmlFile/input.xml" )
- or die ("\n\n### ERROR ###\n\t\tCouldn't open output file, ./output/$xmlFile/input.xml " );
-
- my $resolution;
- foreach $line (<FLATOUTPUT>) {
- if( $line =~ m/\"elementResI\">(\d+)</ ) { $resx = $1; }
- elsif( $line =~ m/\"elementResJ\">(\d+)</ ) { $resy = $1; }
- elsif( $line =~ m/\"elementResK\">(\d+)</ ) { $resz = $1; }
- }
- close( FLATOUTPUT );
-
- #get the total CPU time from plugin
- my @labels;
- my $label;
- my $totalTime;
- my $freqOutput = "./output/$xmlFile/FrequentOutput.dat";
-
- if( !(-e $freqOutput) ) {
- die("\n\n### ERROR ###\nCouldn't open $freqOutput");
- }
- $ii = 0;
- $command = "head -n 1 $freqOutput";
-
- @labels = split( /\s+/, &executeCommandline( $command ) );
- foreach $label (@labels) {
- if( $label =~ m/CPUTime/ ) { last; }
- $ii++;
- }
- $command = "tail -n 1 $freqOutput";
- @labels = split( /\s+/, &executeCommandline( $command ) );
- $totalTime = $labels[$ii-1];
- $testReport .= "[Bitten] time=$totalTime\n";
-
- #append to report string
- $testReport .= "[Bitten] resx=$resx\n";
- $testReport .= "[Bitten] resy=$resy\n";
- if ( defined $resz ) { $testReport .= "[Bitten] resz=$resz\n"; }
- else { $testReport .= "[Bitten] resz=0\n"; }
-
- # return convergence file name
- $command = "ls *\.cvg 2>/dev/null";
- my $cvg = &executeCommandline($command);
- chomp( $cvg );
- return $cvg;
-}
-
-sub readOptionsFile {
- my ( $optFile, $procs, $commandLines ) = @_;
- my $line;
- # $line_I represents the number of tests to run
- my $line_I = 0;
- # open options file
- open OPTFILE, "<$optFile" || die "Can't open options file $optFile, stopped" ;
- foreach $line (<OPTFILE>) {
- chomp $line;
- # only process lines that start with np
- if( $line =~ m/^np\s+(\d+)(\s*$|\s+(.*))/ ) {
- $procs->[$line_I] = $1;
- $commandLines->[$line_I] = $2;
- $line_I++;
- } else { next; }
- }
- return $line_I;
-}
-
-sub testConvergence {
- my $datFile = $_[0];
- my @keys;
- my $tolerance = 1e-3;
- my @errors;
- my $line;
- my $nKeys;
- my $nErrs;
- my $report;
- my $result;
- my $command;
- my $ii;
- # test convergence numbers
- open(INPUT, "<$datFile") || die "Can't open the expected file $datFile\n" ;
- while ($line = <INPUT>) {
- chomp $line;
- if ( $line =~ m/^\#Res\s.*/ ) {
- # parse for variable labels
- @keys = split (/\s+/, $line );
- }
- else {
- @errors = split(/\s+/, $line );
- }
- }
-
- # ensure the number of keys and error measures agree
- $nKeys = @keys;
- $nErrs = @errors;
-
- if( $nKeys != $nErrs ) { die "The number of keys against the number of errors in file $datFile don't agreed\n"; }
-
- $result = "Pass";
- $report = "";
-
- $testReport .= "[Bitten] tolerance=$tolerance\n";
-
- # go through all errors and check if they're within tolerance
- for( $ii = 1 ; $ii < $nKeys ; $ii++ ) {
- if( abs($errors[$ii]) > $tolerance ) {
- $result = "Fail";
- $report .= "***BAD NEWS*** ... $keys[$ii] differs by more than " . $tolerance*100 . "\% tolerance from expected file, error is $errors[$ii]\n";
- $testReport .= "[Bitten] error in $keys[$ii]=$errors[$ii]\n";
- } else {
- $report .= "pass ... $keys[$ii] within a ". $tolerance*100 ."\% relative tolerance from expected file\n";
- $testReport .= "[Bitten] error in $keys[$ii]=$errors[$ii]\n";
- }
- }
-
- close( INPUT );
-
- print "\n$report";
- print "\nResult = $result\n";
-
- $testReport .= "[Bitten] status=$result\n";
-
- # remove the used data file
- $command = "rm $datFile";
- &executeCommandline($command);
-
- open ( JERICO_FILE, "+>.jericoFile" );
- print JERICO_FILE "$testReport\n";
- close( JERICO_FILE );
-
- if( $result eq "Pass" ) {
- exit(0);
- } else {
- exit(1);
- }
-}
-
-
-sub executeCommandline {
-# pass in single string to execute on the command
- my $command = $_[0];
-
- my $output = qx{$command}; # that's the new shell's $$
- my $exitStatus = $? >> 8;
-
- # check the exit status of the command
- if( $exitStatus ne 0 ) { die "\n\n### ERROR ###\nCouldn't execute the command\n$command\n\n"; }
-
- return $output;
-}
diff -r f14bcac1cb23 -r 8fb4d7491dd4 script/dist.py
--- a/script/dist.py Tue Mar 23 08:15:25 2010 -0700
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,220 +0,0 @@
-import os, shutil
-from SCons.Script import *
-
-class ToolInstWarning(SCons.Warnings.Warning):
- pass
-
-SCons.Warnings.enableWarningClass(ToolInstWarning)
-
-def to_list(var):
- if isinstance(var, str):
- return [var]
- elif var is None:
- return []
- elif isinstance(var, list):
- return var
- elif isinstance(var, tuple):
- return list(var)
- else:
- return [var]
-
-def multiget(dicts, key, default=None):
- for d in dicts:
- if d.has_key(key):
- return d[key]
- else:
- return default
-
-def copytree(src, dest, symlinks=False, ignore=None):
- def copyItems(src, dest):
- dir_list = os.listdir(src)
- if ignore:
- ignored = ignore(src, dir_list)
- dir_list = [n for n in dir_list if n not in ignored]
- for item in dir_list:
- srcPath = os.path.join(src, item)
- if os.path.isdir(srcPath):
- srcBasename = os.path.basename(srcPath)
- destDirPath = os.path.join(dest, srcBasename)
- if not os.path.exists(destDirPath):
- os.makedirs(destDirPath)
- copyItems(srcPath, destDirPath)
- elif os.path.islink(srcPath):
- pass
-# elif os.path.islink(srcPath) and symlinks:
-# linkto = os.readlink(srcPath)
-# os.symlink(linkto, dest)
- else:
- shutil.copy2(srcPath, dest)
-
- # case 'cp -R src/ dest/' where dest/ already exists
- if os.path.exists(dest):
- if os.path.isdir(src):
- destPath = os.path.join(dest, os.path.basename(src))
- if not os.path.exists(destPath):
- os.makedirs(destPath)
- else:
- destPath = dest
- # case 'cp -R src/ dest/' where dest/ does not exist
- else:
- os.makedirs(dest)
- destPath = dest
- # actually copy the files
- if os.path.isdir(src):
- copyItems(src, destPath)
- else:
- shutil.copy2(src, destPath)
-
-def check_target(env, target_name, **kw):
- target = multiget([kw, env], target_name)
- return target in COMMAND_LINE_TARGETS
-
-def check_inst_target(env, **kw):
- return check_target(env, "INST_TARGET", **kw) or \
- check_target(env, "BIN_TARGET", **kw)
-
-def check_bin_target(env, **kw):
- return check_target(env, "BIN_TARGET", **kw)
-
-def check_dist_target(env, **kw):
- return check_target(env, "DIST_TARGET", **kw)
-
-def get_prefix(env, **kw):
- if check_inst_target(env, **kw):
- prefix = multiget([kw, env], "INST_PREFIX", "")
- else:
- prefix = multiget([kw, env], "INST_BUILD_DIR", "")
- return prefix
-
-def modify_args(env, **kw):
- new_kw = dict(kw)
- if check_inst_target(env, **kw):
- prefix = multiget([kw, env], "INST_PREFIX", "")
- build_dir = multiget([kw, env], "INST_BUILD_DIR", "")
-
- if build_dir:
- rpaths = multiget([kw, env], "RPATH", [])
- if not isinstance(rpaths, list):
- rpaths = [rpaths]
- rpaths = [p for p in rpaths if p != build_dir + "/lib"]
- rpaths.append(prefix + "/lib")
-
- if build_dir:
- lib_paths = multiget([kw, env], "LIBPATH", [])
- if not isinstance(lib_paths, list):
- lib_paths = [lib_paths]
- lib_paths = [p for p in lib_paths if p != build_dir + "/lib"]
- lib_paths.append(prefix + "/lib")
-
- new_kw["RPATH"] = rpaths
- new_kw["LIBPATH"] = lib_paths
-
- return new_kw
-
-def generate(env, **kw):
-
- env.SetDefault(INST_TARGET="install",
- DIST_TARGET="dist",
- DIST_EXCLUDE_PATTERNS=[".*", "*.pyc"],
- BIN_TARGET="binary")
-
- def Install(env, target, source, **kw):
- prefix = get_prefix(env, **kw)
- nodes = env.SConsInstall(os.path.join(prefix, target[0]), source, **kw)
- return nodes
-
- def Library(env, target, source, **kw):
- prefix = get_prefix(env, **kw)
- nodes = env.SConsLibrary(os.path.join(prefix, target[0]), source, **kw)
- return nodes
-
- def SharedLibrary(env, target, source, **kw):
- prefix = get_prefix(env, **kw)
- new_kw = modify_args(env, **kw)
- nodes = env.SConsSharedLibrary(os.path.join(prefix, target[0]), source, **new_kw)
- return nodes
-
- def Program(env, target, source, **kw):
- prefix = get_prefix(env, **kw)
- new_kw = modify_args(env, **kw)
- nodes = env.SConsProgram(os.path.join(prefix, target[0]), source, **new_kw)
- return nodes
-
- def Dist(env, target, source, **kw):
- if check_dist_target(env, **kw):
- n = env.DistTar(target, source, **kw)
- env.Alias(multiget([kw, env], "DIST_TARGET"), n)
- env.AlwaysBuild(n)
- else:
- n = []
- return n
-
- def DistTarAction(target, source, env):
- import shutil, fnmatch, tarfile
-
- def ignore(cur_dir, cur_names):
- ptrns = to_list(env.get("DIST_EXCLUDE_PATTERNS", []))
- excludes = []
- for n in cur_names:
- if target[0].abspath == os.path.join(cur_dir, n):
- excludes.append(n)
- continue
- for p in ptrns:
- if fnmatch.fnmatch(n, p):
- excludes.append(n)
- return excludes
-
- import tempfile
- tmp_dir = tempfile.mkdtemp()
- src_dir = os.path.basename(str(target[0]))[:-len(".tar.gz")]
-
- dir = os.path.join(tmp_dir, src_dir)
- for s in source:
- copytree(str(s), dir, symlinks=True, ignore=ignore)
-
- f = tarfile.open(str(target[0]), "w:gz")
- old_dir = os.getcwd()
- os.chdir(tmp_dir)
- f.add(src_dir)
- f.close()
- os.chdir(old_dir)
-
- def DistTarPrint(target, source, env):
- return "Creating distribution '%s'"%(target[0])
-
-# def Binary(env, target, source, **kw):
-# dir = multiget([kw, env], "DIST_TMP_DIR")
-# env.Command([Mkdir(dir), Copy(dir
-# target = source
-# prefix = multiget([kw, env], "INST_PREFIX")
-# dist_target = multiget([kw, env], "DIST_TARGET")
-# if dist_target is None or prefix is None or \
-# dist_target not in COMMAND_LINE_TARGETS:
-# return []
-# env.Command(target[0], prefix, Mkdir(target[0]))
-# return env.Alias(dist_target, target[0],
-# env.Tar(env.CopyAs(Dir(target[0]), Dir(prefix)),
-# TARFLAGS="-cz",
-# TARSUFFIX=".tar.gz"),
-# Mkdir(Dir(prefix)))
-
- env.SConsInstall = env.Install
- env["BUILDERS"]["Install"] = Install
- env["BUILDERS"]["SConsLibrary"] = env["BUILDERS"]["Library"]
- env["BUILDERS"]["Library"] = Library
- env["BUILDERS"]["SConsSharedLibrary"] = env["BUILDERS"]["SharedLibrary"]
- env["BUILDERS"]["SharedLibrary"] = SharedLibrary
- env["BUILDERS"]["SConsProgram"] = env["BUILDERS"]["Program"]
- env["BUILDERS"]["Program"] = Program
- env["BUILDERS"]["Dist"] = Dist
- env["BUILDERS"]["DistTar"] = env.Builder(action=env.Action(DistTarAction, DistTarPrint),
- suffix="tar.gz",
- target_factory=env.File,
- source_factory=env.fs.Entry)
-
- AddOption("--dist-version", dest="dist_version", nargs=1, type="string",
- action="store", help="Distribution version",
- default="unknown")
-
-def exists(env):
- return True
diff -r f14bcac1cb23 -r 8fb4d7491dd4 script/dist.pyc
Binary file script/dist.pyc has changed
diff -r f14bcac1cb23 -r 8fb4d7491dd4 script/macroanalyze/createtables.sh
--- a/script/macroanalyze/createtables.sh Tue Mar 23 08:15:25 2010 -0700
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,5 +0,0 @@
-#!/bin/sh
-rm -f proto.txt defargs.txt parentchildhashtable.txt structs.txt
-./script/macroanalyze/runproto.sh
-./script/macroanalyze/rungetdefs.sh
-./script/macroanalyze/rungetstructs.sh
diff -r f14bcac1cb23 -r 8fb4d7491dd4 script/macroanalyze/doominc.pl
--- a/script/macroanalyze/doominc.pl Tue Mar 23 08:15:25 2010 -0700
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,528 +0,0 @@
-#################################################################################################################################
-#################################################################################################################################
-sub getargsfromdefarg{
- my ($str) = @_;
- my $res;
- if($str=~/_(\w+)_New/){
- $str = uc $1;
- $str = "$str"."_DEFARGS";
- }
- #if($str eq "STG_CLASS_DEFARGS" || $str eq "STG_OBJECT_DEFARGS" || $str eq "STG_COMPONENT_DEFARGS"){
- if($str eq "STG_CLASS_DEFARGS"){
- #print "str is $str\n";
- $str="SizeT _sizeOfSelf, Type type, Stg_Class_DeleteFunction* _delete, Stg_Class_PrintFunction* _print, Stg_Class_CopyFunction* _copy";
- return "$str";
- }
- else{
- my $nextpart = $getdefarg{ $str };
- #print "str is $str\n";
- if($nextpart ne ''){
- #print "From defargs.txt \n $nextpart\n";
- $nextpart =~ s/\n//g;
- $nextpart =~ s/\\//g;
- $nextpart =~ s/\s+/ /g;
- $nextpart =~ /\#define\s+(\w+)\s+(\w+)\s*\,*\s*(.*)/;
- if($nextpart eq ''){
- return "Failed!\n";
- }
- my $rem = $3;
- #print "$1 $2 $3 \n";
- my $tmp=$2;
- $tmp=~s/\s*(\w+)\s*/$1/;
- $tmp=~s/(\w+)_\w*ARGS/$1_DEFARGS/; ## some of the defs in this file have *_ARGS instead of *_DEFARGS
- #print "XX$tmp -- $nextpart"."XX\n";
- if($tmp =~ /SizeT/){
- return "$tmp"." $rem";
- }
- my $str = &getargsfromdefarg($tmp);
- if($rem ne ''){
- $res = "$str".", $rem";
- }
- else{
- $res = "$str";
- }
- return $res;
- }
- else{
- return "str $str Failed";
- }
- }
-
-}
-sub getall{
- my ($str) = @_;
- my $res;
- if($str=~/_(\w+)_New/){
- $str = uc $1;
- $str = "$str"."_DEFARGS";
- }
- #if($str eq "STG_CLASS_DEFARGS" || $str eq "STG_OBJECT_DEFARGS" || $str eq "STG_COMPONENT_DEFARGS"){
- if($str eq "STG_CLASS_DEFARGS"){
- #print "str is $str\n";
- $str="SizeT _sizeOfSelf, Type type, Stg_Class_DeleteFunction* _delete, Stg_Class_PrintFunction* _print, Stg_Class_CopyFunction* _copy";
- return "$str";
- }
- else{
- my $nextpart = $getproperdefarg{ $str };
- print "str is $str\n";
- if($nextpart eq ''){
- return "Failed!\n";
- }
- if($nextpart ne ''){
- $nextpart =~ s/\n//g;
- $nextpart =~ s/\s+/ /g;
- $nextpart =~ s/\\//g;
- $nextpart =~ /\#define\s*\\?\s*(\w+)\s+(\w+)\s*\,*\s*(.*)/;
- my $rem = $3;
- #print "$1 $2 $3 $rem\n";
- my $tmp=$2;
- $tmp=~s/\s*(\w+.*\w+)\s*/$1/;
- my $str = &getall($tmp);
- if($rem ne ''){
- #$res = "$str".", $rem";
- $res = "$str".", $rem";
- }
- else{
- $res = "$str";
- }
- return $res;
- }
- else{
- return "str $str Failed";
- }
- }
-
-}
-sub getlocationofArg{# returns first location of arg in list
- my($arg, @list) = @_;
- my $i;
- my $loc=-1;
- for $i (0 ..$#list){
- if($arg eq $list[$i]){
- $loc = $i;
- return $loc;
- }
- }
- return $loc;
-}
-sub getlocationArrayofArgs{
- my ($a, $l) = @_;
- my @args;
- my @list;
- my $i;
- my @loc;
- @args = @$a;
- @list = @$l;
- for $i (0 .. $#args){
- $loc[$i]=&getlocationofArg($args[$i], at list);
- if($loc[$i] != -1){
- $list[$loc[$i]] = "$list[$loc[$i]]"."removed"; # remove arg from list so we don't find it twice if we have repeated args
- }
- }
- return @loc;
-}
-sub getlocationArrayofArgsNEWOLD{
- my ($ta, $a, $tb, $b) = @_;
- my @args;
- my @list;
- my $i;
- my @loc;
- my $tmp;
- @targsA=@$ta;
- @targsB=@$tb;
- @argsA = @$a;
- @argsB = @$b;
- for $i (0 .. $#targsA){
- $tmp = "$targsA[$i]"."$argsA[$i]";
- $tmp =~ s/_//g;
- $tmp =~ s/\*//g;
- $tmp = uc $tmp;
- $args[$i]=$tmp;
- }
- for $i (0 .. $#targsB){
- $tmp = "$targsB[$i]"."$argsB[$i]";
- $tmp =~ s/_//g;
- $tmp =~ s/\*//g;
- $tmp = uc $tmp;
- $list[$i]=$tmp;
- }
- for $i (0 .. $#args){
- $loc[$i]=&getlocationofArg($args[$i], at list);
- if($loc[$i] != -1){
- $list[$loc[$i]] = "$list[$loc[$i]]"."removed"; # remove arg from list so we don't find it twice if we have repeated args
- }
- }
- return @loc;
-}
-sub cleanargs{
- my (@args) = @_;
- my $i=0;
- foreach $term (@args){
- $term =~ s/^\s*(.+)/$1/;
- if($term =~ /^(.+)\s+$/){ $term = $1;}
- $args[$i] = $term;
- $i++;
- }
- return @args;
-}
-sub capandreduceargs{
- my (@args) = @_;
- my $i=0;
- foreach $term (@args){
- $term =~ s/^\s*(.+)/$1/;
- if($term =~ /^(.+)\s+$/){ $term = $1;}
- $term =~ s/_//g;
- $term = uc $term;
- $args[$i] = $term;
- $i++;
- }
- return @args;
-}
-sub gettypes{
- my ($key) = @_;
- my $args;
- my $argsarray;
- my $term;
- my $stars;
- my $word;
- my @type=();
- my $i;
-
- #print "$key in gettypes\n";
- #print Dumper(@type);
- #print " ..in gettypes\n";
- $args = $getproto{$key};
- $args =~ s/\r//g;
- #print "In getypes $key gives\n$args\n";
- @argsarray = split(/,/,$args);
- #print Dumper(@argsarray);
- $i=0;
- if($#argsarray > 0){
-
- foreach $term (@argsarray){
- #print "$term\n";
- $term =~ s/^\s*(.+)/$1/;
- if($term =~ /^(.+)\s+$/){ $term = $1;}
- if($term =~ /$reg/){
- #print "$1 $2 $3\n";
- $stars = $2;
- $word = $1;
-
- #$var[$i] = "$3";
-
- #print "$word >>$3<<\n";
-
- $stars =~ s/\s+//g;
- $word =~ s/\s+/ /g;
- $type[$i] = "$word$stars";
- #print "$type[$i] >$var[$i]<\n";
- }
- else{
- print "Empty arg? >>$args<<\n";
-
- exit;
- }
- #print "$term\n";
-
-
- $i++;
- }#foreach
- }
- return @type;
-}
-sub getvars{
- my ($key) = @_;
- my $args;
- my $argsarray;
- my $term;
- my @var=();
- my $i;
-
- #print "$key in getvars\n";
- #print Dumper(@var);
- #print ".. in getvars\n";
- $args = $getproto{$key};
- $args =~ s/\r//g;
- #print "$args\n";
- @argsarray = split(/,/,$args);
- #print Dumper(@argsarray);
- $i=0;
- if($#argsarray > 0){
-
- foreach $term (@argsarray){
- #print "$term\n";
- $term =~ s/^\s*(.+)/$1/;
- if($term =~ /^(.+)\s+$/){ $term = $1;}
- if($term =~ /$reg/){
- #print "$1 $2 $3\n";
- #$stars = $2;
- #$word = $1;
-
- $var[$i] = "$3";
-
- #print "$word >>$3<<\n";
-
- #$stars =~ s/\s+//g;
- #$word =~ s/\s+/ /g;
- #$type[$i] = "$word$stars";
- #print "$type[$i] >$var[$i]<\n";
- }
- else{
- print "Empty arg in getvars? >>$args<<\n";
- print "filename $filename\n";
- exit;
- }
- #print "$term\n";
-
-
- $i++;
- }#foreach
- }
- return @var;
-}
-sub gettypesfromstr{
- my ($args) = @_;
- my $argsarray;
- my $term;
- my $stars;
- my $word;
- my @type=();
- my $i;
-
- $args =~ s/\r//g;
- #print "$args\n";
- @argsarray = split(/,/,$args);
- #print Dumper(@argsarray);
- $i=0;
- if($#argsarray > 0){
-
- foreach $term (@argsarray){
- #print "$term\n";
- $term =~ s/^\s*(.+)/$1/;
- if($term =~ /^(.+)\s+$/){ $term = $1;}
- if($term =~ /$reg/){
- #print "$1 $2 $3\n";
- $stars = $2;
- $word = $1;
-
- #$var[$i] = "$3";
-
- #print "$word >>$3<<\n";
-
- $stars =~ s/\s+//g;
- $word =~ s/\s+/ /g;
- $type[$i] = "$word$stars";
- #print "$type[$i] >$var[$i]<\n";
- }
- else{
- print "Empty arg? gettypesfromstr >>$args<<\n";
- print "filename $filename\n";
- exit;
- }
- #print "$term\n";
-
-
- $i++;
- }#foreach
- }
- return @type;
-}
-sub getvarsfromstr{
- my ($args) = @_;
- my $argsarray=();
- my $term;
- my @var=();
- my $i;
-
- $args =~ s/\r//g;
- if($args =~ /\,/){## need at least one comma for a list
- @argsarray = split(/,/,$args);
- }
- else{## handle case where we have a list of one element
- $argsarray[0] = $args;
- $term=$args;
- $term =~ s/^\s*(.+)/$1/;
- if($term =~ /^(.+)\s+$/){ $term = $1;}
- if($term =~ /$reg/){
-
- $var[0] = "$3";
-
- }
- #print "HERE >>$args<< >>$var[0]<<\n\n";
- return @var;
- }
- #print Dumper(@argsarray);
- $i=0;
- if($#argsarray > 0){
-
- foreach $term (@argsarray){
- #print "$term\n";
- $term =~ s/^\s*(.+)/$1/;
- if($term =~ /^(.+)\s+$/){ $term = $1;}
- if($term =~ /$reg/){
-
- $var[$i] = "$3";
-
- }
- else{
- print "Empty arg in getvarsfromstr? >>$args<<\n";
- print "filename $filename\n";
- exit;
- }
- #print "$term\n";
-
-
- $i++;
- }#foreach
- }
- return @var;
-}
-sub getclass{
- my ($fn) = @_;
- my $class = $fn;
-
- if($class =~ /_*(\w+)_[A-Za-z]*New/){
- $class = $1;
- $class = uc $class;
- } else { $class = 'x'; }
-
- return $class;
-}
-sub getfargsverbatim{
- my ($fn) = @_;
- my $args = $fn;
- $args =~ s/\w+New[^()]*($paren)[^{}]*.*/$1/s;
- $args =~ s/\((.*)\)/$1/s;
- return $args;
-}
-sub cleanstr{
- my ($str) = @_;
- $str =~ s/^\((.*)\)$/$1/s;
- $str =~ s{/\* (?: (?!\*/). )* \*/}{}gxs; #match /*any*/ as long as 'any' does not contain '*/'
- $str =~ s/assert\s*$paren\s*\;//; # get rid of pesky assert functions
- $str =~ s{//.*}{}g; # get rid of any c++ style comments as well
- $str =~ s{\n([ \t]*\n)*}{\n}g;
- $str =~ s{^([ \t]*\n)+}{}g;
- $str =~ s/\n//g;
- $str =~ s/[ \t]+/ /g;
- return $str;
-}
-sub getfargs{
- my ($fn) = @_;
- my $args = $fn;
- $args =~ s/\w+New[^()]*($paren)[^{}]*.*/$1/s;
- $args =~ s/^\((.*)\)$/$1/s;
- $args =~ s{/\* (?: (?!\*/). )* \*/}{}gxs; #match /*any*/ as long as 'any' does not contain '*/'
- $args =~ s{//.*}{}g; # get rid of any c++ style comments as well
- $args =~ s{\n([ \t]*\n)*}{\n}g;
- $args =~ s{^([ \t]*\n)+}{}g;
- $args =~ s/\n//g;
- $args =~ s/[ \t]+/ /g;
- return $args;
-}
-sub getfargsany{
- my ($fn) = @_;
- my $args = $fn;
- $args =~ s/\w+[^()]*($paren)[^{}]*.*/$1/s;
- $args =~ s/^\((.*)\)$/$1/s;
- $args =~ s{/\* (?: (?!\*/). )* \*/}{}gxs; #match /*any*/ as long as 'any' does not contain '*/'
- $args =~ s{//.*}{}g; # get rid of any c++ style comments as well
- $args =~ s{\n([ \t]*\n)*}{\n}g;
- $args =~ s{^([ \t]*\n)+}{}g;
- $args =~ s/\n//g;
- $args =~ s/[ \t]+/ /g;
- return $args;
-}
-sub getfname{
- my ($fn) = @_;
- my $name = $fn;
- $name =~ s/(^\w+New\w*)\s*\(.*$/$1/s;
- return $name;
-}
-sub getfnameany{
- my ($fn) = @_;
- my $name = $fn;
- $name =~ s/(^\w+)\s*\(.*$/$1/s;
- return $name;
-}
-sub getfbodyverbatim{
- my ($fn) = @_;
- my $body = $fn;
- $body =~ s/\w+New[^{}]*($cparen)[^{}]*/$1/s;
- return $body;
-}
-sub getfbodyverbatimany{
- my ($fn) = @_;
- my $body = $fn;
- $body =~ s/\w+[^{}]*($cparen)[^{}]*/$1/s;
- return $body;
-}
-sub getfbody{
- my ($fn) = @_;
- my $body = $fn;
- $body =~ s/\w+New[^{}]*($cparen)[^{}]*/$1/s; #match /*any*/ as long as 'any' does not contain '*/'
- $body =~ s/assert\s*$paren\s*\;//; # get rid of pesky assert functions
- $body =~ s{/\* (?: (?!\*/). )* \*/}{}gxs;
- $body =~ s{\#if 0(?:(?!\#endif).)*\#endif}{}gs;
- $body =~ s{\/\/.*}{}g;
- $body =~ s{^[ \t]*\n([ \t]*\n)*}{\n}g;
- #$body =~ s{^([ \t]*\n)+}{}g; #removes all blank lines
- return $body;
-}
-sub getfbodyany{
- my ($fn) = @_;
- my $body = $fn;
- $body =~ s/\w+[^{}]*($cparen)[^{}]*/$1/s; #match /*any*/ as long as 'any' does not contain '*/'
- $body =~ s/assert\s*$paren\s*\;//; # get rid of pesky assert functions
- $body =~ s{/\* (?: (?!\*/). )* \*/}{}gxs;
- $body =~ s{\#if 0(?:(?!\#endif).)*\#endif}{}gs;
- $body =~ s{\/\/.*}{}g;
- $body =~ s{^[ \t]*\n([ \t]*\n)*}{\n}g;
- #$body =~ s{^([ \t]*\n)+}{}g; #removes all blank lines
- return $body;
-}
-sub getYnotinX{#returns Y-(Y && X)
- my ( $Y, $X) = @_;
- my %original = ();
- my @subY = ();
- map { $original{$_} = 'x' } @$X;
- @subY = grep { !defined $original{$_} } @$Y; ## i.e. $_ takes values from the @Y array and sees if they are in the original hash table
- return @subY ; # returns a subset of @Y
-}
-sub getYinX{#returns (Y && X)
- my ( $Y, $X) = @_;
- my %original = ();
- my @subY = ();
- map { $original{$_} = 'x' } @$X;
- @subY = grep { defined $original{$_} } @$Y; ## i.e. $_ takes values from the @Y array and sees if they are in the original hash table
- return @subY ; # returns a subset of @Y
-}
-sub createdefinestr{
- my ($macro) = @_;
- my $def;
- $def = qr/ ([ \t]*\#define[ \t]+$macro.*\n ## the space between the [] is important; it is a literal space here
- (?:.*\\[ \t]*\n)* # anything that has a backslash as last character i.e. a continuation slash
- #^ needed a . here instead of \s because \s seems to match \n as well while . doesn't unless we use s on the
- # end of the regexp i.e. "xs" instead of "x"
- .*\n) # then get very next line only
- /x;
- return $def;
-}
-sub createdefinestruct{
- my ($macro) = @_;
- my $def;
- $def = qr/ ([ \t]*\#define[ \t]+$macro\s+[\s\\]* ## the space between the [] is important; it is a literal space here
- (?:.*\\[ \t]*\n)* # anything that has a backslash as last character i.e. a continuation slash
- #^ needed a . here instead of \s because \s seems to match \n as well while . doesn't unless we use s on the
- # end of the regexp i.e. "xs" instead of "x"
- .*\n) # then get very next line only
- /x;
- return $def;
-}
-sub repAwithBinCretC{#replace A with B in C and return new C
- my ($a,$b,$c)=@_;
- my $ameta=quotemeta($a);
- $c =~ s/$ameta/$b/;
- return $c;
-}
-1;
diff -r f14bcac1cb23 -r 8fb4d7491dd4 script/macroanalyze/doomstr.pl
--- a/script/macroanalyze/doomstr.pl Tue Mar 23 08:15:25 2010 -0700
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,32 +0,0 @@
-#our ($paren);
-$paren = qr/ ##THIS one seems to work OK.
- \(
- (?:
- [^()]+ # Not parens
- |
- (??{ $paren }) # Another balanced group (not interpolated yet)
- )*
- \)
- /x;
-$cparen = qr/ ##THIS one seems to work OK.
- \{
- (?:
- [^{}]+ # Not parens
- |
- (??{ $cparen }) # Another balanced group (not interpolated yet)
- )*
- \}
- /x;
-$getdefinesall = qr/ ([ \t]*\#define[ \t]+\w+ARGS.*\\[ \t]*\n
- (?:.*\\[ \t]*\n)* # anything that has a backslash as last character i.e. a continuation slash
- .*\n) # then get very next line only
- /x;
-# $getdefinesrem = qr/ [ \t]*\#define[ \t]+\w+ARGS[ \t]*\\[ \t]*\n
-# ((?:.*\\[ \t]*\n)* # anything that has a backslash as last character i.e. a continuation slash
-# .*\n) # then get very next line only
-# /x;
-$reg = qr/^\s*(\w+(?:[ \t]+\w+)*)
- ([ \t\*]+)
- ((?:\w|[\[\]]*)+)\s*$
- # (\w+)
- /x;
diff -r f14bcac1cb23 -r 8fb4d7491dd4 script/macroanalyze/getdefargs.pl
--- a/script/macroanalyze/getdefargs.pl Tue Mar 23 08:15:25 2010 -0700
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,315 +0,0 @@
-#!/usr/bin/perl
-
-use Term::ANSIColor;
-use Data::Dumper;
-
-$dir=`pwd`;
-$dir =~ /((\/\w+)+\/stgUnderworld\w*).*/;
-$UWdir = $1;
-$LIST="$UWdir"."/script/macroanalyze";
-
-unshift(@INC, $LIST);
-
-our $paren;
-our $cparen;
-our $getdefinesall;
-our $reg;
-require 'doomstr.pl';
-require 'doominc.pl';
-our $dir;
-our $UWdir;
-our $filename;
-our $pc;
-our $hugestr;
-our $defargsfile;
-our $withrepofile;
-our %getparent;
-our %getdefarg;
-
-
-#################################################################################################################################
-$dir=`pwd`; #print "$dir\n";
-$dir =~ /((?:\/\w+)+\/stgUnderworld\w+)(.*)/;
-$UWdir = $1;
-
-
-$filename="$ARGV[0]";
-open FILE, "$filename" or die "can't find file: $!\n";
-$hugestr='';
-
-while (<FILE>){
-
- $hugestr .= "$_";
-
-}
-$pc = "$UWdir\/"."parentchildhashtable.txt";
-$defargsfile = "$UWdir\/"."defargs.txt";
-
-## populate the hash tables from file: the files may or may not exist
-open FILE, "$pc";
-while (<FILE>){
- /(\w+)\s(\w+)/;
- $getparent{ $1 } = $2;
-}
-close FILE;
-open FILE, "$defargsfile";
-while (<FILE>){
- /(\w+)\s(.*)/;
- $getdefarg{ $1 } = $2;
-}
-close FILE;
-
-#################################################################################################################################
-#################################################################################################################################
-#################################################################################################################################
-#################################################################################################################################
-#### find all functions that are of the form ?X_?New ############################################################################
- at functions=$hugestr=~/\w+(?:\**\s+|\s+\**|\s+\**\s+)(_\w+New\w*\s*\([^{}]+$cparen)/g; ## Only looking at _X_?New functions now i.e. starting with _
-######### is of form / (?: | | | )( ) / 2nd pair of brackets is the match #################################################
-#################################################################################################################################
-# get fname fbody and fargs and fargslist from the function defn ################################################################
-#######print "filename is $filename\n"; ########################################################################################
-$i=0; $goforth = 1;# $numparents = 0;
-foreach (@functions){
- ##print "$_ :::::\n\n";
- $fname[$i]=&getfname($_);
- $fbody[$i]=&getfbodyverbatim($_);
- ## get parent functions
- $subfuncs[$i]=[$fbody[$i]=~/\W(_(?:\w+_*)+_New[^()]*$paren)/g]; ## must have a _ in front of name i.e. they should because they are private constructors
- $fbodyclean[$i]=&getfbody($_);
- $subfuncsclean[$i]=[$fbodyclean[$i]=~/\W(_(?:\w+_*)+_New[^()]*$paren)/g];
- @pfunc=@{$subfuncsclean[$i]};
- # $#pfunc should be either 0 or -1; else there are too many parent functions in a child function
- if( $#pfunc > 0 ){
- open FILE, ">>log.txt"; print FILE "Function $fname[$i] has too many _New functions in file $filename\n"; close FILE;
- $goforth = 0 ; ## stop processing
- exit;
- }
- if($goforth == 1){
- $cclass[$i]=&getclass($fname[$i]); #list of potential child class names #print "Child class is $cclass[$i] num pfunc = $#pfunc\n";
- if($#pfunc == -1){ $pclass[$i] = $cclass[$i];} # this will remove it when we do AminusB test
- foreach (@pfunc){
- s/\n//g; #print ">>>>>>>>>>$_<<<<<<<<<<<<\n";
- $pclass[$i] = &getclass($_); #list of potential parent class names
- s/[ \t]+/ /g; #print "Class of $_\n is pclass >>$pclass[$i]<<\n"; #if($cclass[$i] ne $pclass[$i]){ $numparents++;}
- }
- }
- $i++;
-}# foreach (@functions)
- at pclasssub = &getYnotinX(\@pclass,\@cclass);
-if($#pclasssub > 0) { open FILE, ">>log.txt"; print FILE "More than one child parent relation found in file $filename\n"; close FILE; }
-# If we are here we have a 1-1 or 1-0 relation between child and parent functions
-# i.e. no child function X has more than 1 parent function Y and may have none
-foreach $Yclass (@pclasssub){
- #print "Y $Yclass mm\n";
- $i=0; $j=0;
- foreach $Xclass (@pclass){
- #print "X $Xclass nn\n";
- if($Xclass eq $Yclass){
- $pclass[$i] = NULL;
- $cclasssub[$j] = $cclass[$i];
- $Xfunc[$j] = $functions[$i]; ## functions in their original form
- $Xname[$j] = $fname[$i];
- $Xbody[$j] = &getfbody($functions[$i]);
- $Xargs[$j] = &getfargs($functions[$i]);
- $XargsVerbatim[$j] = &getfargsverbatim($functions[$i]);
- $XbodyVerbatim[$j] = &getfbodyverbatim($functions[$i]);
- $Yfunc[$j] = $subfuncs[$i][0];## functions in their original form
- $Yname[$j] = &getfname($Yfunc[$j]);
- $Yargs[$j] = &getfargs($Yfunc[$j]);
- #print "Yargs = $Yargs[$j]\n";
- $YargsVerbatim[$j] = &getfargsverbatim($Yfunc[$j]);
- $j++;
- #print "Found a class $cclass\n";
- }
- $i++;
- }
-}
- at Yclass = @pclasssub;
- at Xclass = @cclasssub;
-
-$i=0;
-$reponame=$ARGV[0];
-$reponame =~ /\.\/(\w+)\/.*/;
-$reponame=$1;
-open FILE, ">>$pc";
-open WREP, ">>$withrepofile";
-$i=0;
-foreach (@Xname){
- if( !exists $getparent{ $_ } ){
- print FILE "$_ $Yname[$i]\n";
- print WREP "$_ $Yname[$i] $reponame\n";
- $getparent{ $_ } = $Yname[$i];
- }
- $i++;
-}
-close FILE;
-close WREP;
-### At this point we have all the child parent functions and their classes
-### Usually the above arrays have only one member each
-#################################################################################################################################
-#################################################################################################################################
-### Now check for macros
-$i=0;
-# cool it looks like ALL macros as args end in 'ARGS'
-# Lets just worry about the DEFARGS part i.e. the args to X
-# because we will construct PASSARGS from the DEFARGS anyway
-foreach $args (@Xargs){
- @Xargset = split(/,/,$args);
- #print Dumper(@Xargset);
- $Xhasmacro[$i]=0;
- $Xisplugin[$i]=0;
- if( $#Xargset == 0 ){
- #print "Only has one argument\n";
- if( ($args !~ /\w+\W+\w+/) && ($args !~ /void/) ){
- #print color 'blue'; print "Is a macro $args in $filename\n"; print color 'reset';
- if($args !~ /ARGS/){
- open FILE, ">>log.txt";
- print FILE "Looks like macro but doesn't have ARGS in name $Xname[$i] $args in $filename\n";
- close FILE;
- }
- $Xhasmacro[$i] =1;
- }
- else{
- if($args =~ /ARGS/){
- open FILE, ">>log.txt"; print FILE "has 2 parts to args but has ARGS in it $Xname[$i] $args $filename\n"; close FILE; }
- #print "Is a plugin $Xname[$i] $args $filename\n";
- $Xisplugin[$i]=1;
- }
- }
- $i++;
-}
-
-#Now we know who has macros and who are probably plugins
-## Process the functions that have macros now and build the defarg hash table
-$i=0;
-foreach $Xfuncname (@Xname){
- ###########################################################################################################
- if($Xhasmacro[$i]){
- $Xargs[$i] =~ /(\w+)/;
- $macname = $1;
- $propermacname = "$Xclass[$i]"."_DEFARGS";
- print ">>>>>>>>>$propermacname<<<<<<<<<<<< >>>>>>>>>>>>>>>$macname<<<<<<<<<<<<<<<<\n";
- $headerfile=$filename; $headerfile =~ s/\.c/\.h/; # get the headerfile
- ###########################################################################################################
- if( -e $headerfile){
- open FILE, "$headerfile"; $headerstr='';
- while (<FILE>){ $headerstr .= $_; }
- close FILE;
- $getmacrodefine=&createdefinestr($macname);
- $headerstr =~ /$getmacrodefine/g;
- $hashdefine = $1;
- $hashdefine =~ s/\s+/ /g; # clean it up a bit and make it fit on one line
- #print "$hashdefine\n";
- ###########################################################################################################
- if($hashdefine eq ''){
- print "Could not find definition for $macname. Try again by trying proper macro name\n";
- # Try what the name should be
- $macname=$propermacname;
- $getmacrodefine=&createdefinestr($macname);
- $headerstr =~ /$getmacrodefine/g;
- $hashdefine = $1;
- $hashdefine =~ s/\s+/ /g; # clean it up a bit and make it fit on one line
- #print "$hashdefine\n";
- if($hashdefine eq ''){
- #print "Could not find definition for $macname. Try again by remangling macro name to proper but with ARGS instead of DEFARGS\n";
- # Try what it might be
- $macname = "$Xclass[$i]"."_ARGS";
- $getmacrodefine=&createdefinestr($macname);
- $headerstr =~ /$getmacrodefine/g;
- $hashdefine = $1;
- $hashdefine =~ s/\s+/ /g; # clean it up a bit and make it fit on one line
- #print "$hashdefine\n";
- if($hashdefine eq ''){
- open FILE, ">>log.txt";
- print FILE "Could not find definition for $macname used by $Xname[$i] in $filename. We can assume is equivalent to proper macro that doesn't exist yet!\n";
- close FILE;
- # OK...if a macroname was used but not defined in a function and was not found
- # then it must be defined elsewhere but can be taken to be the same as the proper macro name because it works
- if( !exists $getdefarg{$propermacname} ) {
- $Xargs[$i] =~ /(\w+)/; $macname = $1; # get original macro name from the Xargs again
- open FILE, ">>$defargsfile"; print FILE "$propermacname $macname \#define $propermacname $macname\n"; close FILE;
- # this one won't appear in the properdefargs file because we cannot define it in the proper way yet
- }
- }
- }
- }# if($hashdefine eq '')
- ###########################################################################################################
- if( !exists $getdefarg{$macname} && $hashdefine ne '' ){# then write out the current defn to defargs file
- open FILE, ">>$defargsfile";
- print FILE "$macname $propermacname $hashdefine\n";
- if($macname ne $propermacname){
- print FILE "$propermacname $macname $hashdefine\n";
- }
- close FILE;
- }# if macro name doesn't exist already and we found a defn for it
- if( !exists $getdefarg{$propermacname} && $hashdefine ne '' ){# then write out the current defn to defargs file
- open FILE, ">>$defargsfile";
- print FILE "$propermacname $propermacname $hashdefine\n";
- close FILE;
- }# if proper macro name doesn't exist already and we found a defn for it
- ###########################################################################################################
- }# if headerfile exists
- ###########################################################################################################
- else{
- open FILE, ">>log.txt"; print FILE "Where is the goddam header file for $filename??\n"; close FILE;
- }# if headerfile exists
- ###########################################################################################################
-
- }## if function has a macro for args
- else{## function does not have a macro in its args but we are going to check headerfile anyway to see if a macro is defined there.
- ## Some macros use macros that are defined but not used in their own class's args to its function
- if($Xisplugin[$i] == 0){## and not a plugin
- $propermacname = "$Xclass[$i]"."_DEFARGS";
- $macname = $propermacname;
- $headerfile=$filename; $headerfile =~ s/\.c/\.h/; # get the headerfile
- ###########################################################################################################
- if( -e $headerfile){
- open FILE, "$headerfile"; $headerstr='';
- while (<FILE>){ $headerstr .= $_; }
- close FILE;
- $getmacrodefine=&createdefinestr($macname);
- $headerstr =~ /$getmacrodefine/g;
- $hashdefine = $1;
- $hashdefine =~ s/\s+/ /g; # clean it up a bit and make it fit on one line
- #print "$hashdefine\n";
- ###########################################################################################################
- if($hashdefine eq ''){
- #print "Could not find definition for $macname. Try again by remangling macro name to proper but with ARGS instead of DEFARGS\n";
- # Try what it might be
- $macname = "$Xclass[$i]"."_ARGS";
- $getmacrodefine=&createdefinestr($macname);
- $headerstr =~ /$getmacrodefine/g;
- $hashdefine = $1;
- $hashdefine =~ s/\s+/ /g; # clean it up a bit and make it fit on one line
- #print "$hashdefine\n";
- }# if($hashdefine eq '')
- ## if we still don't find a macro here it doesn't matter..probably doesn't exist
- ###########################################################################################################
- if( !exists $getdefarg{$macname} && $hashdefine ne '' ){# then write out the current defn to defargs file
- open FILE, ">>$defargsfile";
- print FILE "$macname $propermacname $hashdefine\n";
- if($macname ne $propermacname){
- print FILE "$propermacname $macname $hashdefine\n";
- }
- close FILE;
- }# if macro name doesn't exist already and we found a defn for it
- if( !exists $getdefarg{$propermacname} && $hashdefine ne '' ){# then write out the current defn to defargs file
- open FILE, ">>$defargsfile";
- print FILE "$propermacname $propermacname $hashdefine\n";
- close FILE;
- }# if proper macro name doesn't exist already and we found a defn for it
- ###########################################################################################################
- }# if headerfile exists
- ###########################################################################################################
- else{
- open FILE, ">>log.txt"; print FILE "Where is the goddam header file for $filename??\n"; close FILE;
- }# if headerfile exists
- ###########################################################################################################
- }
- }## does not have macro in functions args
- $i++;
- ###########################################################################################################
-}
-#################################################################################################################################
-#################################################################################################################################
diff -r f14bcac1cb23 -r 8fb4d7491dd4 script/macroanalyze/getstructs.pl
--- a/script/macroanalyze/getstructs.pl Tue Mar 23 08:15:25 2010 -0700
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,274 +0,0 @@
-#!/usr/bin/perl
-
-use Term::ANSIColor;
-use Data::Dumper;
-
-$dir=`pwd`;
-$dir =~ /((\/\w+)+\/stgUnderworld\w*).*/;
-$UWdir = $1;
-$LIST="$UWdir"."/script/macroanalyze";
-
-unshift(@INC, $LIST);
-
-our $paren;
-our $cparen;
-our $getdefinesall;
-our $reg;
-require 'doomstr.pl';
-require 'doominc.pl';
-our $dir;
-our $UWdir;
-our $filename;
-our $pc;
-our $hugestr;
-our $structsfile;
-
-#################################################################################################################################
-$dir=`pwd`; #print "$dir\n";
-$dir =~ /((?:\/\w+)+\/stgUnderworld\w+)(.*)/;
-$UWdir = $1;
-
-
-$filename="$ARGV[0]";
-open FILE, "$filename" or die "can't find file: $!\n";
-$hugestr='';
-
-while (<FILE>){
-
- $hugestr .= "$_";
-
-}
-
-$structsfile = "$UWdir\/"."structs.txt";
-
-
-# open FILE, "$structsfile";
-# while (<FILE>){
-# /(\w+)\s(.*)/;
-# $getdefarg{ $1 } = $2;
-# }
-# close FILE;
-
-#################################################################################################################################
-#################################################################################################################################
-#################################################################################################################################
-#################################################################################################################################
-#### find all functions that are of the form ?X_?New ############################################################################
- at functions=$hugestr=~/\w+(?:\**\s+|\s+\**|\s+\**\s+)(_\w+New\w*\s*\([^{}]+$cparen)/g; ## Only looking at _X_?New functions now i.e. starting with _
-######### is of form / (?: | | | )( ) / 2nd pair of brackets is the match #################################################
-#################################################################################################################################
-# get fname fbody and fargs and fargslist from the function defn ################################################################
-#######print "filename is $filename\n"; ########################################################################################
-$i=0; $goforth = 1;# $numparents = 0;
-
-$headerfile=$filename; $headerfile =~ s/\.c/\.h/; # get the headerfile
-###########################################################################################################
-if( -e $headerfile){
-
- open FILE, "$headerfile"; $headerstr='';
- while (<FILE>){ $headerstr .= $_; }
- close FILE;
- $headerstr =~ s/\r//g;
- #$headerstr = &cleanstr($headerstr);
- $headerstr =~ s{/\* (?: (?!\*/). )* \*/}{}gxs;
- $headerstr =~ s{//.*}{}g; # get rid of any c++ style comments as well
- foreach (@functions){
- $fname[$i]=&getfname($_);
- ## Construct a macro name
- $Xstructname = $fname[$i];
- $Xstructname =~ s/(.*)_New/_$1/;
-
- print "Structname $Xstructname\n";
- $getmacrodefine=&createdefinestruct($Xstructname);
-
- while ($headerstr =~ /$getmacrodefine/g){
- $hashdefine = $1;
- $hashdefine = &cleanstr($hashdefine); # clean it up a bit and make it fit on one line
- $hashdefine =~ s/\\//g;
- $hashdefine = &cleanstr($hashdefine);
- $hashdefine =~ s/^\s*//;
- $hashdefine =~ s/(\W)struct(\W)/$1$2/g;
- $hashdefine =~ s/\{//g;
- $hashdefine =~ s/\}//g;
- $hashdefine =~ s/\s*$//;
- $hashdefine = &cleanstr($hashdefine);
- $hashdefine =~ s/\#define//;
- $hashdefine =~ s/^\s*//;
- print "Define $hashdefine\n";
- open FILE, ">>$structsfile";
- ##print FILE "$Xstructname $hashdefine\n";
- print FILE "$hashdefine\n";
- close FILE;
- }
- $i++;
- }# foreach (@functions)
-
-}# if headerfile exists
-exit;
-
-#################################################################################################################################
-#################################################################################################################################
-### Now check for macros
-$i=0;
-# cool it looks like ALL macros as args end in 'ARGS'
-# Lets just worry about the DEFARGS part i.e. the args to X
-# because we will construct PASSARGS from the DEFARGS anyway
-foreach $args (@Xargs){
- @Xargset = split(/,/,$args);
- #print Dumper(@Xargset);
- $Xhasmacro[$i]=0;
- $Xisplugin[$i]=0;
- if( $#Xargset == 0 ){
- #print "Only has one argument\n";
- if( ($args !~ /\w+\W+\w+/) && ($args !~ /void/) ){
- #print color 'blue'; print "Is a macro $args in $filename\n"; print color 'reset';
- if($args !~ /ARGS/){
- open FILE, ">>log.txt";
- print FILE "Looks like macro but doesn't have ARGS in name $Xname[$i] $args in $filename\n";
- close FILE;
- }
- $Xhasmacro[$i] =1;
- }
- else{
- if($args =~ /ARGS/){
- open FILE, ">>log.txt"; print FILE "has 2 parts to args but has ARGS in it $Xname[$i] $args $filename\n"; close FILE; }
- #print "Is a plugin $Xname[$i] $args $filename\n";
- $Xisplugin[$i]=1;
- }
- }
- $i++;
-}
-
-#Now we know who has macros and who are probably plugins
-## Process the functions that have macros now and build the defarg hash table
-$i=0;
-foreach $Xfuncname (@Xname){
- ###########################################################################################################
- if($Xhasmacro[$i]){
- $Xargs[$i] =~ /(\w+)/;
- $macname = $1;
- $propermacname = "$Xclass[$i]"."_DEFARGS";
- print ">>>>>>>>>$propermacname<<<<<<<<<<<< >>>>>>>>>>>>>>>$macname<<<<<<<<<<<<<<<<\n";
- $headerfile=$filename; $headerfile =~ s/\.c/\.h/; # get the headerfile
- ###########################################################################################################
- if( -e $headerfile){
- open FILE, "$headerfile"; $headerstr='';
- while (<FILE>){ $headerstr .= $_; }
- close FILE;
- $getmacrodefine=&createdefinestr($macname);
- $headerstr =~ /$getmacrodefine/g;
- $hashdefine = $1;
- $hashdefine =~ s/\s+/ /g; # clean it up a bit and make it fit on one line
- #print "$hashdefine\n";
- ###########################################################################################################
- if($hashdefine eq ''){
- print "Could not find definition for $macname. Try again by trying proper macro name\n";
- # Try what the name should be
- $macname=$propermacname;
- $getmacrodefine=&createdefinestr($macname);
- $headerstr =~ /$getmacrodefine/g;
- $hashdefine = $1;
- $hashdefine =~ s/\s+/ /g; # clean it up a bit and make it fit on one line
- #print "$hashdefine\n";
- if($hashdefine eq ''){
- #print "Could not find definition for $macname. Try again by remangling macro name to proper but with ARGS instead of DEFARGS\n";
- # Try what it might be
- $macname = "$Xclass[$i]"."_ARGS";
- $getmacrodefine=&createdefinestr($macname);
- $headerstr =~ /$getmacrodefine/g;
- $hashdefine = $1;
- $hashdefine =~ s/\s+/ /g; # clean it up a bit and make it fit on one line
- #print "$hashdefine\n";
- if($hashdefine eq ''){
- open FILE, ">>log.txt";
- print FILE "Could not find definition for $macname used by $Xname[$i] in $filename. We can assume is equivalent to proper macro that doesn't exist yet!\n";
- close FILE;
- # OK...if a macroname was used but not defined in a function and was not found
- # then it must be defined elsewhere but can be taken to be the same as the proper macro name because it works
- if( !exists $getdefarg{$propermacname} ) {
- $Xargs[$i] =~ /(\w+)/; $macname = $1; # get original macro name from the Xargs again
- open FILE, ">>$defargsfile"; print FILE "$propermacname $macname \#define $propermacname $macname\n"; close FILE;
- # this one won't appear in the properdefargs file because we cannot define it in the proper way yet
- }
- }
- }
- }# if($hashdefine eq '')
- ###########################################################################################################
- if( !exists $getdefarg{$macname} && $hashdefine ne '' ){# then write out the current defn to defargs file
- open FILE, ">>$defargsfile";
- print FILE "$macname $propermacname $hashdefine\n";
- if($macname ne $propermacname){
- print FILE "$propermacname $macname $hashdefine\n";
- }
- close FILE;
- }# if macro name doesn't exist already and we found a defn for it
- if( !exists $getdefarg{$propermacname} && $hashdefine ne '' ){# then write out the current defn to defargs file
- open FILE, ">>$defargsfile";
- print FILE "$propermacname $propermacname $hashdefine\n";
- close FILE;
- }# if proper macro name doesn't exist already and we found a defn for it
- ###########################################################################################################
- }# if headerfile exists
- ###########################################################################################################
- else{
- open FILE, ">>log.txt"; print FILE "Where is the goddam header file for $filename??\n"; close FILE;
- }# if headerfile exists
- ###########################################################################################################
-
- }## if function has a macro for args
- else{## function does not have a macro in its args but we are going to check headerfile anyway to see if a macro is defined there.
- ## Some macros use macros that are defined but not used in their own class's args to its function
- if($Xisplugin[$i] == 0){## and not a plugin
- $propermacname = "$Xclass[$i]"."_DEFARGS";
- $macname = $propermacname;
- $headerfile=$filename; $headerfile =~ s/\.c/\.h/; # get the headerfile
- ###########################################################################################################
- if( -e $headerfile){
- open FILE, "$headerfile"; $headerstr='';
- while (<FILE>){ $headerstr .= $_; }
- close FILE;
- $getmacrodefine=&createdefinestr($macname);
- $headerstr =~ /$getmacrodefine/g;
- $hashdefine = $1;
- $hashdefine =~ s/\s+/ /g; # clean it up a bit and make it fit on one line
- #print "$hashdefine\n";
- ###########################################################################################################
- if($hashdefine eq ''){
- #print "Could not find definition for $macname. Try again by remangling macro name to proper but with ARGS instead of DEFARGS\n";
- # Try what it might be
- $macname = "$Xclass[$i]"."_ARGS";
- $getmacrodefine=&createdefinestr($macname);
- $headerstr =~ /$getmacrodefine/g;
- $hashdefine = $1;
- $hashdefine =~ s/\s+/ /g; # clean it up a bit and make it fit on one line
- #print "$hashdefine\n";
- }# if($hashdefine eq '')
- ## if we still don't find a macro here it doesn't matter..probably doesn't exist
- ###########################################################################################################
- if( !exists $getdefarg{$macname} && $hashdefine ne '' ){# then write out the current defn to defargs file
- open FILE, ">>$defargsfile";
- print FILE "$macname $propermacname $hashdefine\n";
- if($macname ne $propermacname){
- print FILE "$propermacname $macname $hashdefine\n";
- }
- close FILE;
- }# if macro name doesn't exist already and we found a defn for it
- if( !exists $getdefarg{$propermacname} && $hashdefine ne '' ){# then write out the current defn to defargs file
- open FILE, ">>$defargsfile";
- print FILE "$propermacname $propermacname $hashdefine\n";
- close FILE;
- }# if proper macro name doesn't exist already and we found a defn for it
- ###########################################################################################################
- }# if headerfile exists
- ###########################################################################################################
- else{
- open FILE, ">>log.txt"; print FILE "Where is the goddam header file for $filename??\n"; close FILE;
- }# if headerfile exists
- ###########################################################################################################
- }
- }## does not have macro in functions args
- $i++;
- ###########################################################################################################
-}
-#################################################################################################################################
-#################################################################################################################################
diff -r f14bcac1cb23 -r 8fb4d7491dd4 script/macroanalyze/lineage.pl
--- a/script/macroanalyze/lineage.pl Tue Mar 23 08:15:25 2010 -0700
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,21 +0,0 @@
-#!/usr/bin/perl
-
-$pc = "parentchildhashtable.txt";
-
-open FILE, "$pc";
-while (<FILE>){
- /(\w+)\s(\w+)/;
- $getparent{ $1 } = $2;
-}
-
-$parent="$ARGV[0]";
-
-print " $parent";
-
-while ($parent ne ''){
- if($getparent{ $parent } ne ''){
- print " => $getparent{ $parent }";
- }
- $parent = $getparent{ $parent };
-}
-print "\n";
diff -r f14bcac1cb23 -r 8fb4d7491dd4 script/macroanalyze/proto.pl
--- a/script/macroanalyze/proto.pl Tue Mar 23 08:15:25 2010 -0700
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,79 +0,0 @@
-#!/usr/bin/perl
-#use Tie::File;
-use Term::ANSIColor;
-$dir=`pwd`;
-$dir =~ /((\/\w+)+\/stgUnderworld\w*).*/;
-$UWdir = $1;
-$LIST="$UWdir"."/script/macroanalyze";
-
-unshift(@INC, $LIST);
-
-our $paren;
-our $cparen;
-our $getdefinesall;
-our $reg;
-require 'doomstr.pl';
-require 'doominc.pl';
-our $dir;
-our $UWdir;
-our $filename;
-our $pc;
-our $hugestr;
-our $defargsfile;
-our $properdefargsfile;
-our $protofile;
-our %getparent;
-our %getdefarg;
-our %getproperdefarg;
-our %getproto;
-#################################################################################################################################
-$dir=`pwd`; #print "$dir\n";
-$dir =~ /((\/\w+)+\/stgUnderworld\w+).*/;
-$UWdir = $1;
-
-$filename="$ARGV[0]";
-
-open FILE, "$filename" or die "can't find file: $!\n";
-$hugestr='';
-
-while (<FILE>){
-
- $hugestr .= "$_";
-
-}
-
-$protofile = "$UWdir\/"."proto.txt";
-#print "Protofile is $protofile\n";
-open FILE, "$protofile";
-while (<FILE>){
- /(\w+)\s(.*)/;
- $getproto{ $1 } = $2;
-}
-close FILE;
-#################################################################################################################################
-#################################################################################################################################
-#################################################################################################################################
-#################################################################################################################################
-#### find all functions that are of the form ?X_?New ############################################################################
- at functions=$hugestr=~/\w+(?:\**\s+|\s+\**|\s+\**\s+)(\w+New\w*\s*\([^{}]+$cparen)/g;
-# is of form / (?: | | | )( ) / 2nd pair of brackets is the match
-#################################################################################################################################
-# get fname fbody and fargs and fargslist from the function defn
-$i=0;
-foreach (@functions){
-
- $fname[$i]=&getfname($_);
- $fbody[$i]=&getfbodyverbatim($_);
- $fargs[$i]=&getfargs($_);
- #print "$fname[$i] ( $fargs[$i] )\n";
- if($fname[$i] =~ /^_\w+/ && !exists $getproto{$fname[$i]} ){
- #print "Yarrrr!\n";
- open FILE, ">>$protofile";
- print FILE "$fname[$i] $fargs[$i]\n";
- close FILE;
- }
- $i++;
-
-}
-#################################################################################################################################
-#################################################################################################################################
diff -r f14bcac1cb23 -r 8fb4d7491dd4 script/macroanalyze/readdefarg.pl
--- a/script/macroanalyze/readdefarg.pl Tue Mar 23 08:15:25 2010 -0700
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,82 +0,0 @@
-#!/usr/bin/perl
-use Term::ANSIColor;
-$dir=`pwd`; #print "$dir\n";
-$dir =~ /((\/\w+)+\/stgUnderworld\w*\/*).*/;
-$UWdir = $1;
-#print "UWDIR = $UWdir\n\n";
-$properdefargsfile = "$UWdir\/"."properdefargs.txt";
-#print "using $properdefargsfile\n\n";
-open FILE, "$properdefargsfile";
-while (<FILE>){
- /(\w+)\s+(.*)/;
- $getproperdefarg{ $1 } = $2;
-}
-close FILE;
-$defargsfile = "$UWdir\/"."defargs.txt";
-open FILE, "$defargsfile";
-while (<FILE>){
- /(\w+)\s+(.*)/;
- $getdefarg{ $1 } = $2;
- #print "==============> $1 $2 <=============\n";
-}
-close FILE;
-
-sub getall{
- my ($str) = @_;
- my $res;
- if($str=~/_(\w+)_New/){
- $str = uc $1;
- $str = "$str"."_DEFARGS";
- }
- #if($str eq "STG_CLASS_DEFARGS" || $str eq "STG_OBJECT_DEFARGS" || $str eq "STG_COMPONENT_DEFARGS"){
- if($str eq "STG_CLASS_DEFARGS"){
- print "$str\n";
- $str="SizeT _sizeOfSelf, Type type, Stg_Class_DeleteFunction* _delete, Stg_Class_PrintFunction* _print, Stg_Class_CopyFunction* _copy";
- return "$str";
- }
- else{
- my $nextpart = $getdefarg{ $str };
- print "$str\n";
- if($nextpart eq ''){
- return "Failed!\n";
- }
- if($nextpart ne ''){
- $nextpart =~ s/\n//g;
- $nextpart =~ s/\s+/ /g;
- $nextpart =~ s/\\//g;
- $nextpart =~ /\#define\s*\\?\s*(\w+)\s+(\w+)\s*\,*\s*(.*)/;
- my $rem = $3;
- #print "$1 $2 $3 $rem\n";
- my $tmp=$2;
- $tmp=~s/\s*(\w+.*\w+)\s*/$1/;
- my $str = &getall($tmp);
- if($rem ne ''){
- #$res = "$str".", $rem";
- $res = "$str".";\n $rem";
- }
- else{
- $res = "$str";
- }
- return $res;
- }
- else{
- return "str $str Failed";
- }
- }
-
-}
-
-$arg="$ARGV[0]";
-
-$test = &getall($arg);
-$test =~ s/\,\s+/\,\n/g;
-$test =~ s/\;\s+/\;\n/g;
-print "\n";
- at ar = split(/;/,$test);
-for $j (0 .. $#ar){
- if($j % 2 == 1){print color 'green'; print "$ar[$j]\n"; print color 'reset';}
- else { print color 'yellow'; print "$ar[$j]\n"; print color 'reset';}
-}
-#print color 'green';
-#print "$test\n";
-#print color 'reset';
diff -r f14bcac1cb23 -r 8fb4d7491dd4 script/macroanalyze/readme.txt
--- a/script/macroanalyze/readme.txt Tue Mar 23 08:15:25 2010 -0700
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,118 +0,0 @@
-Run all scripts from top level directory in stgUnderworld.
-
-Run ./script/macroanalyze/createtables.sh first to create the necessary tables.
-This creates 4 txt files.
-defargs.txt <- contains all macro DEFARG definitions.
-parentchildhashtable.txt <- contains all parent child _X_New function relations
-proto.txt <- contains all parent child _X_New function prototype arguments
-structs.txt <- contains all struct definitions
-
-The scripts than can be directly called are:
--------------------------------------------------------------------------------------------------------------------
-lineage.pl : uses parentchildhashtable.txt
-Usage:
-./script/macroanalyze/lineage _X_New
-e.g.
-./script/macroanalyze/lineage _PCDVC_New
-will produce the hierarchy of functions
- _PCDVC_New => _DVCWeights_New => _WeightsCalculator_New => _Stg_Component_New => _Stg_Object_New => _Stg_Class_New
-
--------------------------------------------------------------------------------------------------------------------
-readdefarg.pl : uses defargs.txt
-Usage:
-./script/macroanalyze/readdefarg.pl _X_DEFARGS
-or
-./script/macroanalyze/readdefarg.pl _X_New
-e.g.
-./script/macroanalyze/readdefarg.pl _PCDVC_New (or PCDVC_DEFARGS)
-will give a list of the hierarchy of macros followed by the expanded form of the macro,
-(with alternating colors of sets of args corresponding to additional args given by each parent macro)
-
-PCDVC_DEFARGS
-DVCWEIGHTS_DEFARGS
-WEIGHTSCALCULATOR_DEFARGS
-STG_COMPONENT_DEFARGS
-STG_OBJECT_DEFARGS
-STG_CLASS_DEFARGS
-SizeT _sizeOfSelf,
-Type type,
-Stg_Class_DeleteFunction* _delete,
-Stg_Class_PrintFunction* _print,
-Stg_Class_CopyFunction* _copy
-
-Name name,
-AllocationType nameAllocationType
-
-Stg_Component_DefaultConstructorFunction* _defaultConstructor,
-Stg_Component_ConstructFunction* _construct,
-Stg_Component_BuildFunction* _build,
-Stg_Component_InitialiseFunction* _initialise,
-Stg_Component_ExecuteFunction* _execute,
-Stg_Component_DestroyFunction* _destroy
-
-WeightsCalculator_CalculateFunction* _calculate
-
--------------------------------------------------------------------------------------------------------------------
-readstruct.pl : uses structs.txt
-Usage:
-./script/macroanalyze/readstruct.pl __X
-e.g.
-./script/macroanalyze/readstruct.pl __PCDVC
-will give a list of the hierarchy of structs followed by the expanded form of the struct,
-(with alternating colors of sets of terms corresponding to additional terms given by each parent struct)
-
-__PCDVC
-__DVCWeights
-__WeightsCalculator
-__Stg_Component
-__Stg_Object
-__Stg_Class
-
-SizeT _sizeOfSelf;
-Type type;
-Stg_Class_DeleteFunction* _delete;
-Stg_Class_PrintFunction* _print;
-Stg_Class_CopyFunction* _copy
-Name name;
-AllocationType nameAllocationType;
-Stg_Component_DefaultConstructorFunction* _defaultConstructor;
-Stg_Component_ConstructFunction* _construct;
-Stg_Component_BuildFunction* _build;
-Stg_Component_InitialiseFunction* _initialise;
-Stg_Component_ExecuteFunction* _execute;
-Stg_Component_DestroyFunction* _destroy;
-Bool isConstructed;
-Bool isBuilt;
-Bool isInitialised;
-Bool hasExecuted;
-Bool isDestroyed;
-Type constructType;
-Type buildType;
-Type initialiseType;
-Type executeType;
-Type destroyType;
-FiniteElementContext* context;
-WeightsCalculator_CalculateFunction* _calculate;
-double cellLocalVolume;
-Dimension_Index dim;
-int resX;
-int resY;
-int resZ;
-MaterialPointsSwarm* materialPointsSwarm;
-double upperT;
-double lowerT;
-Bool splitInInterfaceCells;
-Bool deleteInInterfaceCells;
-int maxDeletions;
-int maxSplits;
-Bool Inflow;
-double CentPosRatio;
-int ParticlesPerCell;
-double Threshold;
-int maxDeletions_orig;
-int maxSplits_orig;
-Bool Inflow_orig;
-Bool splitInInterfaceCells_orig;
-Bool deleteInInterfaceCells_orig;
-
--------------------------------------------------------------------------------------------------------------------
\ No newline at end of file
diff -r f14bcac1cb23 -r 8fb4d7491dd4 script/macroanalyze/readstruct.pl
--- a/script/macroanalyze/readstruct.pl Tue Mar 23 08:15:25 2010 -0700
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,75 +0,0 @@
-#!/usr/bin/perl
-use Term::ANSIColor;
-$dir=`pwd`; #print "$dir\n";
-$dir =~ /((\/\w+)+\/stgUnderworld\w*\/*).*/;
-$UWdir = $1;
-
-$structfile = "$UWdir\/"."structs.txt";
-open FILE, "$structfile";
-while (<FILE>){
- /(\w+)\s+(.*)/;
- $getstruct{ $1 } = $2;
- #print "==============> $1 $2 <=============\n";
-}
-close FILE;
-
-sub getall{
- my ($str) = @_;
- my $res;
- if($str=~/_(\w+)_New/){
- $str = uc $1;
- $str = "$str"."_DEFARGS";
- }
- if($str eq "__Stg_Class"){
- print "$str\n";
- $str="SizeT _sizeOfSelf; Type type; Stg_Class_DeleteFunction* _delete; Stg_Class_PrintFunction* _print; Stg_Class_CopyFunction* _copy";
- return "$str";
- }
- else{
- my $nextpart = $getstruct{ $str };
- print "$str\n";
- if($nextpart eq ''){
- return "Failed!\n";
- }
- if($nextpart ne ''){
- $nextpart =~ s/\n//g;
- $nextpart =~ s/\s+/ /g;
- $nextpart =~ s/\\//g;
- $nextpart =~ /\s*(\w+)\s+(.*)/;
- my $rem = $2;
- #print "$1 $2 $3 $rem\n";
- my $tmp=$1;
- $tmp=~s/^\s*(\w+)/$1/;
- $tmp=~s/(\w+)\s*$/$1/;
- my $str = &getall($tmp);
- if($rem ne ''){
- #$res = "$str".", $rem";
- $res = "$str".":\n $rem";
- }
- else{
- $res = "$str";
- }
- return $res;
- }
- else{
- return "str $str Failed";
- }
- }
-
-}
-
-$arg="$ARGV[0]";
-
-$test = &getall($arg);
-$test =~ s/\,\s+/\,\n/g;
-$test =~ s/\;\s+/\;\n/g;
-print "\n";
- at ar = split(/:/,$test);
-for $j (0 .. $#ar){
- $ar[$j] =~ s/^\s*//;
- if($j % 2 == 1){print color 'green'; print "$ar[$j]\n"; print color 'reset';}
- else { print color 'yellow'; print "$ar[$j]\n"; print color 'reset';}
-}
-#print color 'green';
-#print "$test\n";
-#print color 'reset';
diff -r f14bcac1cb23 -r 8fb4d7491dd4 script/macroanalyze/rungetdefs.sh
--- a/script/macroanalyze/rungetdefs.sh Tue Mar 23 08:15:25 2010 -0700
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,3 +0,0 @@
-#!/bin/sh
-
-find -name "*.c" -exec ./script/macroanalyze/getdefargs.pl \{\} \;
diff -r f14bcac1cb23 -r 8fb4d7491dd4 script/macroanalyze/rungetstructs.sh
--- a/script/macroanalyze/rungetstructs.sh Tue Mar 23 08:15:25 2010 -0700
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,3 +0,0 @@
-#!/bin/sh
-
-find -name "*.c" -exec ./script/macroanalyze/getstructs.pl \{\} \;
diff -r f14bcac1cb23 -r 8fb4d7491dd4 script/macroanalyze/runproto.sh
--- a/script/macroanalyze/runproto.sh Tue Mar 23 08:15:25 2010 -0700
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,3 +0,0 @@
-#!/bin/sh
-
-find -name "*.c" -exec ./script/macroanalyze/proto.pl \{\} \;
diff -r f14bcac1cb23 -r 8fb4d7491dd4 script/restartTest.pl
--- a/script/restartTest.pl Tue Mar 23 08:15:25 2010 -0700
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,428 +0,0 @@
-#!/usr/bin/perl -w
-#
-use strict;
-
-##### SUBROUTINES #####
-sub runTests;
-sub executeCommandline;
-sub testConvergence;
-sub generateConvergence;
-sub testNumbersAgainstExpected;
-sub readOptionsFile;
-
-
-##### GLOBAL VARS #####
-our $testReport = "[Bitten] purpose=test checkpoint restarts by restarting a simulation and checking that its final state is consistent with that achieved by integrating straight through.\n";
-our $cvgFileName = "";
-our $helpStr = "To run restart tests:
-
-./restartTest.pl <xmlFile> [ OPTIONS ]
-
-where OPTIONS:
- -optionsFile <fileName> : where <fileName> is the options file. Command line agruments in StGermain format.
- -n <#> : the timestep checkpoint writing. Testing will occur at twice this timestep
- -np <#> : the number of processors to run. (This value will overwrite the number of preocessors given in the optionsFile
- -serial : will execute test without any mpi binary prefix. (Overwrites \"-np\" option).
- -h : this help message
-
-Also the environment variable \$UNDERWORLD_MPI can be set to specify the mpi binary to be used
-
-EXAMPLE:
- ./restartTest.pl RayleighTaylorBenchmark.xml -optionsFile OFile.dat
- (Runs with option file OFile.dat and checks against the expected file)
-
-";
-
-###### MAIN PROGRAM ######
-
-# 1) Run the xml
-$cvgFileName = &runTests();
-
-# 2) Check against expected, checkpoint files
-exit &testConvergence( $cvgFileName );
-
-###### END MAIN ######
-
-
-sub runTests {
- my $res;
- my $command;
-
- # read commandline args
- my $arg;
- my $ii = 0;
- my $xmlFile = " ";
- my $optFile = " ";
- my $checkpointAndRestartAt = 10; # how often to checkpoint (and timestep to restart at)
- my @procs = (1,1,1,1);
- my @commandLines = ""; #("--elementResI=32 --elementResJ=32 " );
- my $outputPath = " ";
- my $nProcs = -1;
- my $isSerial = 0;
- my $mpiBin = $ENV{'UNDERWORLD_MPI'};
-
- # check if xml exists and options file is specified
- for( $ii = 0 ; $ii < scalar(@ARGV) ; $ii++ ) {
- $arg = $ARGV[$ii];
- if( $arg =~ m/.*\.xml$/ ) { $xmlFile = $arg; }
- elsif( $arg =~ m/\-optionsFile/ ) { $optFile = $ARGV[$ii+1]; $ii++; }
- elsif( $arg =~ m/^\-h$/ ) { print $helpStr; exit }
- elsif( $arg =~ m/^\-\-help$/ ) { print $helpStr; exit }
- elsif( $arg =~ m/^\-n$/ ) { $checkpointAndRestartAt=$ARGV[$ii+1]; $ii++; }
- elsif( $arg =~ m/^\-np/ ) { $nProcs=$ARGV[$ii+1]; $ii++; }
- elsif( $arg =~ m/^\-serial/ ) { $isSerial=1; }
- }
-
- my $numberOfTimeSteps = 2*$checkpointAndRestartAt; # testing timestep is twice that of checkpoint
- if( $xmlFile eq " " ) { die "\n\n### ERROR ###\nNo xml file specified, stopped" ; }
- if( !(-e $xmlFile) ) { die "\n\n### ERROR ###\nCannot find input file: $xmlFile, stopped" ; }
-
- # check if options file is given, otherwise run default
- if( $optFile ne " " ) {
- if( !(-e $optFile) ) { die "\\n### ERROR ###\nnCannot find run options file $optFile, stopped"; }
-
- # read in run options file
- &readOptionsFile( $optFile, \@procs, \@commandLines );
- }
-
- # if commandline option np is valid use it
- if( $nProcs > 0 ) { $procs[0] = $nProcs; }
- if( $isSerial ) { $procs[0] = 1; }
-
- if( $optFile ne " " ) {
- print "\nUsing options file $optFile, specifed options are:\n-n $procs[0] "; foreach (@commandLines) { print "$_ "; }
- }
-
- my $exec = "udw"; # executable name
- my $stdout;
- my $stderr;
-
- # create strings for 1) initial full run & 2) restart run, and testing against checkpointed data
- my $xmlSegmentInitialRun = "<StGermainData xmlns=\"http://www.vpac.org/StGermain/XML_IO_Handler/Jun2003\">
- <param name=\"checkpointEvery\" mergeType=\"replace\">$checkpointAndRestartAt</param>
- <param name=\"outputPath\" mergeType=\"replace\">./restartTestInitialOutput/$xmlFile</param>
- <param name=\"maxTimeSteps\" mergeType=\"replace\">$numberOfTimeSteps</param>
- <param name=\"dumpEvery\" mergeType=\"replace\">0</param>
-</StGermainData>";
- my $xmlSegmentToTest = "<StGermainData xmlns=\"http://www.vpac.org/StGermain/XML_IO_Handler/Jun2003\">
- <struct name=\"components\" mergeType=\"merge\">
- <struct name=\"tester\">
- <param name=\"Type\">FieldTest</param>
- </struct>
- </struct>
-
- <param name=\"outputPath\" mergeType=\"replace\">./restartTestRestartOutput/$xmlFile</param>
- <param name=\"checkpointReadPath\" mergeType=\"replace\">./restartTestInitialOutput/$xmlFile</param>
- <param name=\"checkpointEvery\" mergeType=\"replace\">$checkpointAndRestartAt</param>
- <param name=\"restartTimestep\" mergeType=\"replace\">$checkpointAndRestartAt</param>
- <param name=\"dumpEvery\" mergeType=\"replace\">0</param>
- <param name=\"maxTimeSteps\" mergeType=\"replace\">$checkpointAndRestartAt</param>
- <struct name=\"pluginData\" mergeType=\"replace\">
- <list name=\"NumericFields\">
- <param>VelocityField</param> <param>0</param>
- <param>PressureField</param> <param>1</param>
- <param>TemperatureField</param> <param>2</param>
- </list>
- <param name=\"IntegrationSwarm\">gaussSwarm</param>
- <param name=\"ConstantMesh\">constantMesh</param>
- <param name=\"testTimestep\">$numberOfTimeSteps</param>
- <param name=\"ElementMesh\">linearMesh</param>
- <param name=\"normaliseByAnalyticSolution\">True</param>
- <param name=\"context\">context</param>
- <param name=\"appendToAnalysisFile\">True</param>
- <!-- reference soln stuff -->
- <param name=\"useReferenceSolutionFromFile\">true</param>
- <param name=\"referenceSolutionFilePath\">./restartTestInitialOutput/$xmlFile</param>
- <list name=\"ReferenceFields\">
- <param>VelocityField</param>
- <param>PressureField</param>
- <param>TemperatureField</param>
- </list>
- </struct>
-</StGermainData>";
-
- # Need to check for an executable
- my $stg_exec = $ENV{'STG_EXEC'};
- if( !(-e "./../../../build/bin/StGermain" ) && !(-e $stg_exec ) ) {
- die "\n\n### ERROR ###\nCan not find the StGermain executable, stopped.\n If not in default location, set an environment variable STG_EXEC pointing to executable.\n ";
- }
-
- print "\n--- Testing the $xmlFile ---\n";
-
- # is the symbolic link there, if not create it
- if( !(-e $exec) ) {
- if(-e "./../../../build/bin/StGermain" ) {
- $command = "ln -s ../../../build/bin/StGermain $exec";
- &executeCommandline( $command );
- } elsif(-e $stg_exec) {
- $command = "ln -s $stg_exec $exec";
- &executeCommandline( $command );
- }
- }
-
- # check if there's a log dir
- if( !(-e "log/") ) {
- $command = "mkdir log";
- &executeCommandline( $command );
- }
-
- # declare stdout and stderr files, in log dir.
- $stdout = "log/$xmlFile"."_runs.stdout";
- $stderr = "log/$xmlFile"."_runs.stderr";
-
- # remove old log file, if it exists
- if( -e "$stdout" ) {
- $command = "rm $stdout";
- &executeCommandline( $command );
- }
-
- # remove old cvg file, if it exists
- if( scalar (glob "*.cvg") ) {
- $command = "rm *.cvg";
- &executeCommandline( $command );
- }
-
- # create help.xml for initial run
- $command = "echo \'$xmlSegmentInitialRun\' > help.xml ";
- &executeCommandline($command);
-
- print "\n--- Performing the initial run, checkpointing every $checkpointAndRestartAt steps, running for $numberOfTimeSteps steps ---\n";
-
- # perform initial run
- if( defined($mpiBin) ) { # if custom mpi is specified use it
- $command = "$mpiBin -np $procs[0] ./$exec $xmlFile help.xml $commandLines[0] --pluginData.appendToAnalysisFile=True >$stdout";
- }
- if( $isSerial ) { # if the serial flag is specified don't add anything parallel
- $command = "./$exec $xmlFile help.xml $commandLines[0] --pluginData.appendToAnalysisFile=True >$stdout";
- }
- if( !defined($mpiBin) && !$isSerial ) { # by default use mpich2 standard
- $command = "mpiexec -np $procs[0] ./$exec $xmlFile help.xml $commandLines[0] --pluginData.appendToAnalysisFile=True >$stdout";
- }
- $command .= " 2>$stderr";
- print "$command";
- &executeCommandline( $command );
-
- # check error stream for error result
- open( ERROR, "<$stderr" );
- my $line2;
- foreach $line2 (<ERROR>) {
- if( $line2 =~ m/[E|e]rror/ ) {
- close(ERROR);
- die ("\n\n### ERROR ###\nError in runtime: see $stderr or $stdout - stopped" );
- }
- }
-
- # if no error close file and delete it
- close(ERROR);
- $command = "rm $stderr"; &executeCommandline($command);
-
- # removing help.xml
- $command = "rm help.xml";
- &executeCommandline($command);
-
- # create help.xml for restart run
- $command = "echo \'$xmlSegmentToTest\' > help.xml ";
- &executeCommandline($command);
-
- print "\n\n--- Performing the restart run, restarting at step $checkpointAndRestartAt and comparing with initial run at step $numberOfTimeSteps ---\n";
-
- # perform restart run
- if( defined($mpiBin) ) { # if custom mpi is specified use it
- $command = "$mpiBin -np $procs[0] ./$exec $xmlFile help.xml $commandLines[0] --pluginData.appendToAnalysisFile=True >$stdout";
- }
- if( $isSerial ) { # if the serial flag is specified don't add anything parallel
- $command = "./$exec $xmlFile help.xml $commandLines[0] --pluginData.appendToAnalysisFile=True >$stdout";
- }
- if( !defined($mpiBin) && !$isSerial) { # by default use mpich2 standard
- $command = "mpiexec -np $procs[0] ./$exec $xmlFile help.xml $commandLines[0] --pluginData.appendToAnalysisFile=True >$stdout";
- }
- $command .= " 2>$stderr";
- print "$command";
- &executeCommandline( $command );
-
- # check error stream for error result
- open( ERROR, "<$stderr" );
- my $line;
- foreach $line (<ERROR>) {
- if( $line =~ m/[E|e]rror/ ) {
- close(ERROR);
- die ("\n\n### ERROR ###\nError in runtime: see $stderr or $stdout - stopped" );
- }
- }
-
- # if no error close file and delete it
- close(ERROR);
- $command = "rm $stderr"; &executeCommandline($command);
-
- # removing help.xml
- $command = "rm help.xml";
- &executeCommandline($command);
-
- # removing softlink
- $command = "rm $exec";
- &executeCommandline($command);
-
- print "\n\n--- Finished ---\n\n";
-
- $testReport .= "[Bitten] proc=$procs[0]\n";
-
- #search for resolution to report
- my $resx;
- my $resy;
- my $resz;
- open( FLATOUTPUT, "./restartTestRestartOutput/$xmlFile/input.xml" )
- or die ("\n\n### ERROR ###\n\t\tCouldn't open output file, ./output/$xmlFile/input.xml " );
-
- my $resolution;
- foreach $line (<FLATOUTPUT>) {
- if( $line =~ m/\"elementResI\">(\d+)</ ) { $resx = $1; }
- elsif( $line =~ m/\"elementResJ\">(\d+)</ ) { $resy = $1; }
- elsif( $line =~ m/\"elementResK\">(\d+)</ ) { $resz = $1; }
- }
- close( FLATOUTPUT );
-
- #get the total CPU time from plugin
- my @labels;
- my $label;
- my $totalTime;
- my $freqOutput = "./restartTestRestartOutput/$xmlFile/FrequentOutput.dat";
-
- if( !(-e $freqOutput) ) {
- die("\n\n### ERROR ###\nCouldn't open $freqOutput");
- }
- $ii = 0;
- $command = "head -n 1 $freqOutput";
-
- @labels = split( /\s+/, &executeCommandline( $command ) );
- foreach $label (@labels) {
- if( $label =~ m/CPUTime/ ) { last; }
- $ii++;
- }
- $command = "tail -n 1 $freqOutput";
- @labels = split( /\s+/, &executeCommandline( $command ) );
- $totalTime = $labels[$ii-1];
- $testReport .= "[Bitten] time=$totalTime\n";
-
- #append to report string
- $testReport .= "[Bitten] resx=$resx\n";
- $testReport .= "[Bitten] resy=$resy\n";
- if ( defined $resz ) { $testReport .= "[Bitten] resz=$resz\n"; }
- else { $testReport .= "[Bitten] resz=0\n"; }
-
- # remove data
- $command = "rm -f ./restartTestInitialOutput/$xmlFile/*"; &executeCommandline($command);
- $command = "rm -f ./restartTestRestartOutput/$xmlFile/*"; &executeCommandline($command);
- $command = "rmdir ./restartTestInitialOutput/$xmlFile"; &executeCommandline($command);
- $command = "rmdir ./restartTestRestartOutput/$xmlFile"; &executeCommandline($command);
- $command = "rmdir ./restartTestInitialOutput/"; &executeCommandline($command);
- $command = "rmdir ./restartTestRestartOutput/"; &executeCommandline($command);
-
- # return convergence file name
- $command = "ls *\.cvg 2>/dev/null";
- my $cvg = &executeCommandline($command);
- chomp( $cvg );
- return $cvg;
-}
-
-sub readOptionsFile {
- my ( $optFile, $procs, $commandLines ) = @_;
- my $line;
- # $line_I represents the number of tests to run
- my $line_I = 0;
- # open options file
- open OPTFILE, "<$optFile" || die "Can't open options file $optFile, stopped" ;
- foreach $line (<OPTFILE>) {
- chomp $line;
- # only process lines that start with np
- if( $line =~ m/^np\s+(\d+)\s+(.*)/ ) {
- $procs->[$line_I] = $1;
- $commandLines->[$line_I] = $2;
- $line_I++;
- } else { next; }
- }
- return $line_I;
-}
-
-sub testConvergence {
- my $datFile = $_[0];
- my @keys;
- my $tolerance = 1e-5;
- my @errors;
- my $line;
- my $nKeys;
- my $nErrs;
- my $report;
- my $result;
- my $command;
- my $ii;
- # test convergence numbers
- open(INPUT, "<$datFile") || die "Can't open the expected file $datFile\n" ;
- while ($line = <INPUT>) {
- chomp $line;
- if ( $line =~ m/^\#Res\s.*/ ) {
- # parse for variable labels
- @keys = split (/\s+/, $line );
- }
- else {
- @errors = split(/\s+/, $line );
- }
- }
-
- # ensure the number of keys and error measures agree
- $nKeys = @keys;
- $nErrs = @errors;
-
- if( $nKeys != $nErrs ) { die "The number of keys against the number of errors in file $datFile don't agreed\n"; }
-
- $result = "Pass";
- $report = "";
-
- $testReport .= "[Bitten] tolerance=$tolerance\n";
-
- # go through all errors and check if they're within tolerance
- for( $ii = 1 ; $ii < $nKeys ; $ii++ ) {
- if( abs($errors[$ii]) > $tolerance ) {
- $result = "Fail";
- $report .= "***BAD NEWS*** ... $keys[$ii] differs by more than " . $tolerance*100 . "\% tolerance from expected file, error is $errors[$ii]\n";
- $testReport .= "[Bitten] error in $keys[$ii]=$errors[$ii]\n";
- } else {
- $report .= "pass ... $keys[$ii] within a ". $tolerance*100 ."\% relative tolerance from expected file\n";
- $testReport .= "[Bitten] error in $keys[$ii]=$errors[$ii]\n";
- }
- }
-
- close( INPUT );
-
- print "\n$report";
- print "\nResult = $result\n";
-
- $testReport .= "[Bitten] status=$result\n";
-
- # remove the used data file
- $command = "rm $datFile";
- &executeCommandline($command);
-
- open ( JERICO_FILE, "+>.jericoFile" );
- print JERICO_FILE "$testReport\n";
- close( JERICO_FILE );
-
- if( $result eq "Pass" ) {
- exit(0);
- } else {
- exit(1);
- }
-}
-
-
-sub executeCommandline {
-# pass in single string to execute on the command
- my $command = $_[0];
-
- my $output = qx{$command}; # that's the new shell's $$
- my $exitStatus = $? >> 8;
-
- # check the exit status of the command
- if( $exitStatus ne 0 ) { die "\n\n### ERROR ###\nCouldn't execute the command\n$command\n\n"; }
-
- return $output;
-}
diff -r f14bcac1cb23 -r 8fb4d7491dd4 script/systest.pl
--- a/script/systest.pl Tue Mar 23 08:15:25 2010 -0700
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,392 +0,0 @@
-#!/usr/bin/perl -w
-#
-use strict;
-
-##### SUBROUTINES #####
-sub runTests;
-sub executeCommandline;
-sub testConvergence;
-sub generateConvergence;
-sub testNumbersAgainstExpected;
-sub readOptionsFile;
-
-
-##### GLOBAL VARS #####
-our $testReport = "[Bitten] purpose=test current numerical fields against previously checkpoint fields of this model\n";
-our $cvgFileName = "";
-our $helpStr = "To run checkpoint tests:
-
- systest.pl <xmlFile> [ OPTIONS ]
-
-where OPTIONS:
- -optionsFile <fileName> : where <fileName> is the options file. Command line agruments in StGermain format.
- -D <outputPath> : the output path were the checkpoint files are directed.
- -c : will \"create\" checkpointed data only. By default this flag in not set and the script only checks against previous checkpointed data.
- -n <#> : the timestep checkpoint writing (if -c is defined) or checkpoint testing will occur on. By default this is timestep 10.
- -np <#> : the number of processors to run. (This value will overwrite the number of preocessors given in the optionsFile
- -serial : will execute test without any mpi binary prefix. (Overwrites \"-np\" option).
- -h : this help message
-
-Also the environment variable \$UNDERWORLD_MPI can be set to specify the mpi binary to be used
-
-EXAMPLE:
- ./systest.pl RayleighTaylorBenchmark.xml -optionsFile OFile.dat
- (Runs with option file OFile.dat and checks against the expected file)
-
-";
-
-###### MAIN PROGRAM ######
-
-# 1) Run the xml
-$cvgFileName = &runTests();
-
-# 2) Check against expected, checkpoint files
-exit &testConvergence( $cvgFileName );
-
-###### END MAIN ######
-
-
-sub runTests {
- my $res;
- my $command;
- my $createTest=0; #boolean to create an expected file, defaut 0
-
- # read commandline args
- my $arg;
- my $ii = 0;
- my $xmlFile = " ";
- my $optFile = " ";
- my $numberOfTimeSteps = 5; # testing Timestep is 10 by default
- my @procs = (1,1,1,1);
- my @commandLines = ""; #("--elementResI=32 --elementResJ=32 " );
- my $outputPath = "./expected/";
- my $nProcs = -1;
- my $isSerial = 0;
- my $mpiBin = $ENV{'UNDERWORLD_MPI'};
-
- # check if xml exists and options file is specified
- for( $ii = 0 ; $ii < scalar(@ARGV) ; $ii++ ) {
- $arg = $ARGV[$ii];
- if( $arg =~ m/.*\.xml$/ ) { $xmlFile = $arg; }
- elsif( $arg =~ m/\-optionsFile/ ) { $optFile = $ARGV[$ii+1]; $ii++; }
- elsif( $arg =~ m/^\-h/ ) { print $helpStr; exit }
- elsif( $arg =~ m/^\-\-help/ ) { print $helpStr; exit }
- elsif( $arg =~ m/^\-c/ ) { $createTest=1; }
- elsif( $arg =~ m/^\-n$/ ) { $numberOfTimeSteps=$ARGV[$ii+1]; $ii++; }
- elsif( $arg =~ m/^\-D/ ) { $outputPath=$ARGV[$ii+1]; $ii++; }
- elsif( $arg =~ m/^\-np/ ) { $nProcs=$ARGV[$ii+1]; $ii++; }
- elsif( $arg =~ m/^\-serial/ ) { $isSerial=1; }
- }
- if( $xmlFile eq " " ) { die "\n\n### ERROR ###\nNo xml file specified, stopped" ; }
- if( !(-e $xmlFile) ) { die "\n\n### ERROR ###\nCannot find input file: $xmlFile, stopped" ; }
-
- # check if options file is given, otherwise run default
- if( $optFile ne " " ) {
- if( !(-e $optFile) ) { die "\\n### ERROR ###\nnCannot find run options file $optFile, stopped"; }
-
- # read in run options file
- &readOptionsFile( $optFile, \@procs, \@commandLines );
- }
-
- # if commandline option np is valid use it
- if( $nProcs > 0 ) { $procs[0] = $nProcs; }
- if( $isSerial ) { $procs[0] = 1; }
-
- if( $optFile ne " " ) {
- print "\nUsing options file $optFile, specifed options are:\n-n $procs[0] "; foreach (@commandLines) { print "$_ "; }
- }
-
- my $exec = "udw"; # executable name
- my $stdout;
- my $stderr;
-
- $outputPath = $outputPath."/$xmlFile";
-
- # create strings for 1) creating checkpoint data & 2) testing against checkpointed data
- my $xmlSegmentCreateTest = "<StGermainData xmlns=\"http://www.vpac.org/StGermain/XML_IO_Handler/Jun2003\">
- <param name=\"checkpointEvery\" mergeType=\"replace\">$numberOfTimeSteps</param>
- <param name=\"outputPath\" mergeType=\"replace\">$outputPath</param>
- <param name=\"maxTimeSteps\" mergeType=\"replace\">$numberOfTimeSteps</param>
- <param name=\"dumpEvery\" mergeType=\"replace\">0</param>
-</StGermainData>";
- my $xmlSegmentToTest = "<StGermainData xmlns=\"http://www.vpac.org/StGermain/XML_IO_Handler/Jun2003\">
- <struct name=\"components\" mergeType=\"merge\">
- <struct name=\"tester\">
- <param name=\"Type\">FieldTest</param>
- </struct>
- </struct>
-
- <param name=\"outputPath\" mergeType=\"replace\">$outputPath</param>
- <param name=\"checkpointEvery\" mergeType=\"replace\">0</param>
- <param name=\"dumpEvery\" mergeType=\"replace\">0</param>
- <param name=\"maxTimeSteps\" mergeType=\"replace\">$numberOfTimeSteps</param>
- <struct name=\"pluginData\" mergeType=\"replace\">
- <list name=\"NumericFields\">
- <param>VelocityField</param> <param>0</param>
- <param>PressureField</param> <param>1</param>
- <param>TemperatureField</param> <param>2</param>
- </list>
- <param name=\"IntegrationSwarm\">gaussSwarm</param>
- <param name=\"ConstantMesh\">constantMesh</param>
- <param name=\"testTimestep\">$numberOfTimeSteps</param>
- <param name=\"ElementMesh\">linearMesh</param>
- <param name=\"normaliseByAnalyticSolution\">True</param>
- <param name=\"context\">context</param>
- <param name=\"appendToAnalysisFile\">True</param>
- <!-- reference soln stuff -->
- <param name=\"useReferenceSolutionFromFile\">true</param>
- <param name=\"referenceSolutionFilePath\">$outputPath</param>
- <list name=\"ReferenceFields\">
- <param>VelocityField</param>
- <param>PressureField</param>
- <param>TemperatureField</param>
- </list>
- </struct>
-</StGermainData>";
-
- # Need to check for an executable
- if( !(-e "./../../../build/bin/StGermain" ) ) {
- die "\n\n### ERROR ###\nCan't find ./../../../build/bin/StGermain - the executable which runs the test, stopped";
- }
-
- if( $createTest ) {
- print "\n--- Creating checkpoint files for $xmlFile at timestep $numberOfTimeSteps---\n";
- } else {
- print "\n--- Testing the $xmlFile ---\n";
- }
-
- # is the symbolic link there, if not create it
- if( !(-e $exec) ) {
- $command = "ln -s ../../../build/bin/StGermain $exec";
- print "\n$command\n\n";
- &executeCommandline( $command );
- }
-
- # check if there's a log dir
- if( !(-e "log/") ) {
- $command = "mkdir log";
- &executeCommandline( $command );
- }
-
- # declare stdout and stderr files, in log dir.
- $stdout = "log/$xmlFile"."_runs.stdout";
- $stderr = "log/$xmlFile"."_runs.stderr";
-
- # remove old log file, if it exists
- if( -e "$stdout" ) {
- $command = "rm $stdout";
- &executeCommandline( $command );
- }
-
- # remove old cvg file, if it exists
- if( scalar (glob "*.cvg") ) {
- $command = "rm *.cvg";
- &executeCommandline( $command );
- }
-
- # create help.xml for setting up test
- if( $createTest ) {
- $command = "echo \'$xmlSegmentCreateTest\' > help.xml ";
- } else {
- $command = "echo \'$xmlSegmentToTest\' > help.xml ";
- }
- &executeCommandline($command);
-
- # run test case
- if( defined($mpiBin) ) { # if custom mpi is specified use it
- $command = "$mpiBin -np $procs[0] ./$exec $xmlFile help.xml $commandLines[0] --pluginData.appendToAnalysisFile=True >$stdout";
- }
- if( $isSerial ) { # if the serial flag is specified don't add anything parallel
- $command = "./$exec $xmlFile help.xml $commandLines[0] --pluginData.appendToAnalysisFile=True >$stdout";
- }
- if( !defined($mpiBin) && !$isSerial ) { # by default use mpich2 standard
- $command = "mpiexec -np $procs[0] ./$exec $xmlFile help.xml $commandLines[0] --pluginData.appendToAnalysisFile=True >$stdout";
- }
- $command .= " 2>$stderr";
- print "$command";
- &executeCommandline( $command );
-
- # check error stream for error result and produce warning
- my $rm_stderr = 1;
- open( ERROR, "<$stderr" );
- my $line;
- foreach $line (<ERROR>) {
- if( $line =~ m/[E|e]rror/ ) {
- close(ERROR);
- warn ("\n\n### Warning ###\nError reported in runtime: see $stderr - stopped" );
- $rm_stderr=0;
- last; # break out of the foreach loop
- }
- }
-
- # if no error close file and delete it
- close(ERROR);
- if( $rm_stderr ) { $command = "rm $stderr"; &executeCommandline($command); }
-
- # removing help.xml
- $command = "rm help.xml";
- print "\n$command\n"; &executeCommandline($command);
-
- # removing softlink
- $command = "rm $exec";
- print "$command\n"; &executeCommandline($command);
-
- print "--- Finished ---\n\n";
-
- # if we're only creating checkpoint file, end program here
- if( $createTest ) { exit(0); }
-
- $testReport .= "[Bitten] proc=$procs[0]\n";
-
- #search for resolution to report
- my $resx;
- my $resy;
- my $resz;
- open( FLATOUTPUT, "$outputPath/input.xml" )
- or die ("\n\n### ERROR ###\n\t\tCouldn't open output file, ./output/$xmlFile/input.xml " );
-
- my $resolution;
- foreach $line (<FLATOUTPUT>) {
- if( $line =~ m/\"elementResI\">(\d+)</ ) { $resx = $1; }
- elsif( $line =~ m/\"elementResJ\">(\d+)</ ) { $resy = $1; }
- elsif( $line =~ m/\"elementResK\">(\d+)</ ) { $resz = $1; }
- }
- close( FLATOUTPUT );
-
- #get the total CPU time from plugin
- my @labels;
- my $label;
- my $totalTime;
- my $freqOutput = "./$outputPath/FrequentOutput.dat";
-
- if( !(-e $freqOutput) ) {
- die("\n\n### ERROR ###\nCouldn't open $freqOutput");
- }
- $ii = 0;
- $command = "head -n 1 $freqOutput";
-
- @labels = split( /\s+/, &executeCommandline( $command ) );
- foreach $label (@labels) {
- if( $label =~ m/CPUTime/ ) { last; }
- $ii++;
- }
- $command = "tail -n 1 $freqOutput";
- @labels = split( /\s+/, &executeCommandline( $command ) );
- $totalTime = $labels[$ii-1];
- $testReport .= "[Bitten] time=$totalTime\n";
-
- #append to report string
- $testReport .= "[Bitten] resx=$resx\n";
- $testReport .= "[Bitten] resy=$resy\n";
- if ( defined $resz ) { $testReport .= "[Bitten] resz=$resz\n"; }
- else { $testReport .= "[Bitten] resz=0\n"; }
-
- # return convergence file name
- $command = "ls *\.cvg 2>/dev/null";
- my $cvg = &executeCommandline($command);
- chomp( $cvg );
- return $cvg;
-}
-
-sub readOptionsFile {
- my ( $optFile, $procs, $commandLines ) = @_;
- my $line;
- # $line_I represents the number of tests to run
- my $line_I = 0;
- # open options file
- open OPTFILE, "<$optFile" || die "Can't open options file $optFile, stopped" ;
- foreach $line (<OPTFILE>) {
- chomp $line;
- # only process lines that start with np
- if( $line =~ m/^np\s+(\d+)(\s*$|\s+(.*))/ ) {
- $procs->[$line_I] = $1;
- $commandLines->[$line_I] = $2;
- $line_I++;
- } else { next; }
- }
- return $line_I;
-}
-
-sub testConvergence {
- my $datFile = $_[0];
- my @keys;
- my $tolerance = 1e-3;
- my @errors;
- my $line;
- my $nKeys;
- my $nErrs;
- my $report;
- my $result;
- my $command;
- my $ii;
- # test convergence numbers
- open(INPUT, "<$datFile") || die "Can't open the expected file $datFile\n" ;
- while ($line = <INPUT>) {
- chomp $line;
- if ( $line =~ m/^\#Res\s.*/ ) {
- # parse for variable labels
- @keys = split (/\s+/, $line );
- }
- else {
- @errors = split(/\s+/, $line );
- }
- }
-
- # ensure the number of keys and error measures agree
- $nKeys = @keys;
- $nErrs = @errors;
-
- if( $nKeys != $nErrs ) { die "The number of keys against the number of errors in file $datFile don't agreed\n"; }
-
- $result = "Pass";
- $report = "";
-
- $testReport .= "[Bitten] tolerance=$tolerance\n";
-
- # go through all errors and check if they're within tolerance
- for( $ii = 1 ; $ii < $nKeys ; $ii++ ) {
- if( abs($errors[$ii]) > $tolerance ) {
- $result = "Fail";
- $report .= "***BAD NEWS*** ... $keys[$ii] differs by more than " . $tolerance*100 . "\% tolerance from expected file, error is $errors[$ii]\n";
- $testReport .= "[Bitten] error in $keys[$ii]=$errors[$ii]\n";
- } else {
- $report .= "pass ... $keys[$ii] within a ". $tolerance*100 ."\% relative tolerance from expected file\n";
- $testReport .= "[Bitten] error in $keys[$ii]=$errors[$ii]\n";
- }
- }
-
- close( INPUT );
-
- print "\n$report";
- print "\nResult = $result\n";
-
- $testReport .= "[Bitten] status=$result\n";
-
- # remove the used data file
- $command = "rm $datFile";
- &executeCommandline($command);
-
- open ( JERICO_FILE, "+>.jericoFile" );
- print JERICO_FILE "$testReport\n";
- close( JERICO_FILE );
-
- if( $result eq "Pass" ) {
- exit(0);
- } else {
- exit(1);
- }
-}
-
-
-sub executeCommandline {
-# pass in single string to execute on the command
- my $command = $_[0];
-
- my $output = qx{$command}; # that's the new shell's $$
- my $exitStatus = $? >> 8;
-
- # check the exit status of the command
- if( $exitStatus ne 0 ) { die "\n\n### ERROR ###\nCouldn't execute the command\n$command\n\n"; }
-
- return $output;
-}
diff -r f14bcac1cb23 -r 8fb4d7491dd4 updateRepos.py
--- a/updateRepos.py Tue Mar 23 08:15:25 2010 -0700
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,39 +0,0 @@
-#!/usr/bin/env python
-"""
-This scipt will update Underworld repositories to a specific branch.
-The one argument this script uses is the branch name, eg.
- ./updateRepos.py v1.3.x
-
-"""
-
-from mercurial import hg, ui, util
-import urllib2
-import ConfigParser
-import os, errno
-import sys
-
-deps = [
- '.', 'config', 'gLucifer', 'PICellerator', 'StgDomain' , 'StGermain' , 'StgFEM' , 'Underworld' , 'Experimental' \
- ] #, 'Experimental/PDERework/config', 'Experimental/Magma/config' ]
-
-cwd = os.getcwd()
-
-# check if there are
-if len(sys.argv) != 2:
- print "ERROR - must supply one argument only (the branch name), currently\n"
- print sys.argv
- print "\nExample usage: ./updateRepos.py v1.3.x\n\n"
- sys.exit()
-
-for dep in deps:
- if not os.path.exists(cwd + "/" + dep ):
- continue
-
- os.chdir(cwd + "/" + dep)
- # get the branch name
- branch = os.popen('hg branch').readlines()
- branch = branch[0].replace("\n","")
- # check branch
- os.system("hg up -C " + sys.argv[1])
- print "updating " + dep + " to branch " + sys.argv[1]
-
More information about the CIG-COMMITS
mailing list