summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--lib/sbin/Runtest.pl179
-rw-r--r--lib/sbin/create_c_stuff.pl16
-rw-r--r--lib/sbin/create_fortran_stuff.pl2
-rw-r--r--lib/sbin/parameter_parser.pl11
-rw-r--r--lib/sbin/schedule_parser.pl12
5 files changed, 101 insertions, 119 deletions
diff --git a/lib/sbin/Runtest.pl b/lib/sbin/Runtest.pl
index 7881f2b8..be98ee12 100644
--- a/lib/sbin/Runtest.pl
+++ b/lib/sbin/Runtest.pl
@@ -1,12 +1,10 @@
#!/bin/perl -s
#
-# Test Suite tool. Needs a few comments up here ...
-# Version: $Id$
-#
+# Test Suite tool
+# Version: $Header$
+
-# Fix this for NT
$sep = "/";
-$seps = "/";
$config = $ARGV[0];
@@ -15,14 +13,6 @@ $tolerance = 13;
$ansinormal = "\033[0m";
$ansibold = "\033[1m";
-print <<EOT;
-
--------------------------------
- Cactus Code Test Suite Tool
--------------------------------
-
-EOT
-
# Work out where the config directory is
if($ENV{"CONFIGS_DIR"})
{
@@ -35,9 +25,10 @@ else
$current_directory = `pwd`;
chop($current_directory);
-
$current_directory =~ s,^//([^/]+)/,$1:/,;
+&print_header;
+
# Look to see if MPI is defined
$extra = "$current_directory${sep}configs${sep}$config${sep}config-data${sep}cctk_extradefs.h";
@@ -66,54 +57,59 @@ else
{
$command = &defprompt("Enter command to run executable"," ");
}
-$tests = &defprompt("Run All tests or go to Menu",
- "All");
+$tests = &defprompt("Run All tests or go to Menu","All");
+
+
# Get the active thorns list and test files with thorns
$scratchdir = "$configs_dir$sep$config";
if (!open (AT, "< $scratchdir${sep}ThornList")) {
print "Can't open $scratchdir/ThornList - no thorn tests";
-} else {
- printf ("Reading Thorn List\n");
- while (<AT>) {
- @t = split(' ');
- foreach $T (@t) {
- if (-d "arrangements${sep}$T${sep}test")
- {
- $thisdir = `pwd`;
- chop($thisdir);
- chdir "arrangements${sep}$T${sep}test";
- while ($file=<*.par>)
- {
- @testfiles = (@testfiles, $file);
- @testthorns = (@testthorns, $T);
- }
- chdir "$thisdir";
- }
- }
+}
+else
+{
+ printf ("Reading Thorn List\n");
+ while (<AT>)
+ {
+ @t = split(' ');
+ foreach $T (@t) {
+ if (-d "arrangements${sep}$T${sep}test")
+ {
+ $thisdir = `pwd`;
+ chop($thisdir);
+ chdir "arrangements${sep}$T${sep}test";
+ while ($file=<*.par>)
+ {
+ @testfiles = (@testfiles, $file);
+ @testthorns = (@testthorns, $T);
+ }
+ chdir "$thisdir";
+ }
}
+ }
}
# Parse the parameter files for directives
$ntests = 0;
-foreach $t (@testfiles) {
- $ntests++;
- $file = "arrangements/@testthorns[$ntests-1]/test/$t";
- open (IN, "<$file") || die "Can not open $file";
- while (<IN>)
+foreach $t (@testfiles)
+{
+ $ntests++;
+ $file = "arrangements/@testthorns[$ntests-1]/test/$t";
+ open (IN, "<$file") || die "Can not open $file";
+ while (<IN>)
+ {
+ if (/^\s*\#\s*DESC(RIPTION)?\s*\"(.*)\"\s*$/i)
{
- if (/^\s*\#\s*DESC(RIPTION)?\s*\"(.*)\"\s*$/i)
- {
- $testnames{$ntests} = $2
- }
+ $testnames{$ntests} = $2
}
- close IN;
+ }
+ close IN;
}
if ($tests =~ /All/) {
-# Run all parameter files
+ # Run all parameter files
$ntests=0;
$number_failed=0;
$number_zerofiles=0;
@@ -126,8 +122,11 @@ if ($tests =~ /All/) {
&runtest($t,$thorn,$ntests);
}
+
+# Show the statistics
+
print "==================================================\n";
- print "All tests run for configuration $config\n";
+ print "All tests run for configuration $config\n\n";
print " Tests run -> $ntests\n";
print " Number passed -> $number_passed1\n";
if ($number_passed2 > 0)
@@ -135,9 +134,18 @@ if ($tests =~ /All/) {
print " (Number passed to only $tolerance digits -> $number_passed2)\n";
}
print " Number failed -> $number_failed\n";
+
+ if ($number_failed>0)
+ {
+ print "\n Tests failed:\n";
+ for ($i=0; $i<$number_failed;$i++)
+ {
+ print " ".@which_failed[$i]."\n";
+ }
+ }
if ($number_zerofiles > 0)
{
- print " Number with no output files -> $number_zerofiles\n";
+ print " Number with no output files -> $number_zerofiles\n";
}
print "==================================================\n\n";
}
@@ -152,7 +160,7 @@ else
$ntests = 0;
foreach $t (@testfiles) {
$ntests++;
- $t =~ m:([^${seps}]+).par$:;
+ $t =~ m:([^${sep}]+).par$:;
$num = $1;
$inp{$num} = $t;
$testnum{$ntests} = $num;
@@ -185,43 +193,17 @@ sub runtest {
mkdir ($tsttop,0755);
$tp = $inpf;
- $tp =~ s:^.*$seps::;
+ $tp =~ s:^.*$sep::;
$tp =~ s/.par//;
$test_base_dir = $inpf;
- $test_base_dir =~ s:[^${seps}]*$::;
-
- $pretest = "$test_base_dir$tp.pretest";
- $posttest = "$test_base_dir$tp.posttest";
+ $test_base_dir =~ s:[^${sep}]*$::;
print "Running $tp: $testnames{$num}\n";
unlink(<$tsttop${sep}$tp${sep}*.*>);
-# Run a pre-test script if it exists
-
- if( -x $pretest)
- {
- print "Running pre-test script $pretest\n";
- open (CMD, "(cd $tsttop; ..${sep}$pretest ..${sep}$test_base_dir) |");
- open (LOG, "> $tsttop${sep}$tp.prestep.log");
- while (<CMD>) {
- print LOG;
- }
- close LOG;
- close CMD;
-
- $retcode = $? >> 8;
-
- if($retcode > 0)
- {
- print "$pretest exited with error code $retcode\n";
- print "Aborting test\n";
- return;
- }
- }
-
- $cmd = "($command $current_directory$sep$executable ..$sep$inpf)";
+ $cmd = "($command $current_directory$sep$executable $current_directory$sep$inpf)";
chdir ($tsttop);
@@ -249,12 +231,12 @@ sub runtest {
print "${ansibold}Cactus exited with error code $retcode $ansinormal \n";
print "Please check the logfile $tsttop$sep$tp.log\n\n";
$number_failed++;
-
+ @which_failed = (@which_failed,$tp);
return;
}
$indir = $inpf;
- $indir =~ s:.par:${seps}:g;
+ $indir =~ s:.par:${sep}:g;
@oldout = <$indir${sep}*.*l>;
$blewit = 0;
@@ -264,7 +246,7 @@ sub runtest {
foreach $file (@oldout) {
$nfiles ++;
$newfile = $file;
- $newfile =~ s:^.*${seps}([^${seps}]+)$:\1:;
+ $newfile =~ s:^.*${sep}([^${sep}]+)$:\1:;
$newfile = "$tsttop$sep$tp$sep$newfile";
# print "Comparing $file with $newfile\n";
@@ -297,7 +279,7 @@ sub runtest {
if ($nblow != 0) {
$blewit ++;
$stripfile = $newfile;
- $stripfile =~ s:^.*${seps}(.*)$:\1:;
+ $stripfile =~ s:^.*${sep}(.*)$:\1:;
if ($nrealblow == 0) {
print " $stripfile differs at machine precision (which is OK!)\n";
} else {
@@ -330,30 +312,11 @@ sub runtest {
printf "\n $ansibold TEST FAILED!!:$ansinormal ".
"$nfiles compared, $blewit files differ, $reallyblewit differ significantly\n";
$number_failed++;
- }
- }
- printf ("\n\n");
+ @which_failed = (@which_failed,$tp);
-# Run a post-test script if it exists
- if( -x $posttest)
- {
- print "Running post-test script $posttest\n";
- open (CMD, "(cd $tsttop; ..$sep$posttest ..$sep$test_base_dir) |");
- open (LOG, "> $tsttop$sep$tp.posttest.log");
- while (<CMD>) {
- print LOG;
- }
- close LOG;
- close CMD;
-
- $retcode = $? >> 8;
-
- if($retcode > 0)
- {
- print "$posttest exited with error code $retcode\n";
- return;
}
}
+ printf ("\n\n");
}
@@ -375,3 +338,15 @@ sub fpabs {
local ($val) = @_[0];
$val > 0 ? $val:-$val;
}
+
+
+sub print_header
+{
+ print <<EOT;
+
+-------------------------------
+ Cactus Code Test Suite Tool
+-------------------------------
+
+EOT
+}
diff --git a/lib/sbin/create_c_stuff.pl b/lib/sbin/create_c_stuff.pl
index 99971354..e7027311 100644
--- a/lib/sbin/create_c_stuff.pl
+++ b/lib/sbin/create_c_stuff.pl
@@ -195,7 +195,7 @@ sub set_parameter_code
push(@lines,(" if(CCTK_Equals(param, \"$parameter\"))", " {"));
- if( $type ne "STRING" && $type ne "SENTENCE" && $type ne "LOGICAL")
+ if( $type ne "STRING" && $type ne "SENTENCE" && $type ne "BOOLEAN")
{
if( $type eq "KEYWORD")
{
@@ -227,7 +227,7 @@ sub set_parameter_code
{
$line = " retval = CCTK_SetString(\&($structure.$parameter),value);" ;
}
- elsif( $type eq "LOGICAL")
+ elsif( $type eq "BOOLEAN")
{
$line = " retval = CCTK_SetLogical(\&($structure.$parameter), value);" ;
@@ -283,7 +283,7 @@ sub set_parameter_default
$line = " strcpy($structure.$parameter, $default);";
push(@lines, $line);
}
- elsif($type eq "LOGICAL")
+ elsif($type eq "BOOLEAN")
{
# Logicals need to be done specially.
@@ -331,7 +331,7 @@ sub get_c_type_string
{
$type_string = "char *";
}
- elsif($type eq "LOGICAL")
+ elsif($type eq "BOOLEAN")
{
$type_string = "CCTK_INT ";
}
@@ -487,7 +487,7 @@ sub order_params
{
push(@string_params, $parameter);
}
- elsif($type eq "LOGICAL" ||
+ elsif($type eq "BOOLEAN" ||
$type eq "INT")
{
push(@int_params, $parameter);
@@ -544,10 +544,10 @@ sub get_parameter_code
$line = " *value = \&($structure.$parameter);\n" ;
$line .= " retval = PARAMETER_REAL;" ;
}
- elsif($type eq "LOGICAL")
+ elsif($type eq "BOOLEAN")
{
$line = " *value = \&($structure.$parameter);\n" ;
- $line .= " retval = PARAMETER_LOGICAL;" ;
+ $line .= " retval = PARAMETER_BOOLEAN;" ;
}
else
{
@@ -603,7 +603,7 @@ sub create_parameter_code
$line = " strcpy($structure.$parameter, $default);";
push(@lines, $line);
}
- elsif($type eq "LOGICAL")
+ elsif($type eq "BOOLEAN")
{
# Logicals need to be done specially.
diff --git a/lib/sbin/create_fortran_stuff.pl b/lib/sbin/create_fortran_stuff.pl
index 9677e3aa..7517f9ef 100644
--- a/lib/sbin/create_fortran_stuff.pl
+++ b/lib/sbin/create_fortran_stuff.pl
@@ -187,7 +187,7 @@ sub get_fortran_type_string
{
$type_string = "CCTK_STRING ";
}
- elsif($type eq "LOGICAL" ||
+ elsif($type eq "BOOLEAN" ||
$type eq "INT")
{
$type_string = "CCTK_INT";
diff --git a/lib/sbin/parameter_parser.pl b/lib/sbin/parameter_parser.pl
index 12996a36..8b824f31 100644
--- a/lib/sbin/parameter_parser.pl
+++ b/lib/sbin/parameter_parser.pl
@@ -144,11 +144,18 @@ sub parse_param_ccl
$parameter_db{"\U$thorn $block\E variables"} = "";
}
}
- elsif($line =~ m:(EXTENDS |USES )?\s*(?\:CCTK_)?(INT|REAL|LOGICAL|KEYWORD|STRING)\s*([a-zA-Z]+[a-zA-Z0-9_]*) \s*(\"[^\"]*\"):i)
+ elsif($line =~ m:(EXTENDS |USES )?\s*(?\:CCTK_)?(INT|REAL|LOGICAL|BOOLEAN|KEYWORD|STRING)\s*([a-zA-Z]+[a-zA-Z0-9_]*) \s*(\"[^\"]*\"):i)
{
# This is a parameter definition.
$type = "\U$2\E";
+
+ # Logical is depricated
+ if ($type =~ /LOGICAL/)
+ {
+ $type = "BOOLEAN";
+ }
+
$variable = $3;
$description = $4;
@@ -235,7 +242,7 @@ sub parse_param_ccl
$message = "Default given for $type $variable in $thorn is not a string";
&CST_error(0,$message,__LINE__,__FILE__);
}
- elsif ($type =~ m:LOGICAL: && $default =~ m:": && $default !~ m:".*":)
+ elsif ($type =~ m:BOOLEAN: && $default =~ m:": && $default !~ m:".*":)
{
$message = "Default given for $type $variable in $thorn is missing a quote";
&CST_error(0,$message,__LINE__,__FILE__);
diff --git a/lib/sbin/schedule_parser.pl b/lib/sbin/schedule_parser.pl
index 5ad04b59..93c3fae9 100644
--- a/lib/sbin/schedule_parser.pl
+++ b/lib/sbin/schedule_parser.pl
@@ -322,7 +322,7 @@ sub parse_schedule_ccl
}
# Parse the non-schedule storage line
- elsif ($line =~ m/\s*STORAGE\s*:\s*(.*)\s*$/i)
+ elsif ($line =~ m/\s*STOR[^\:]*:\s*(.*)\s*$/i)
{
if ($type eq "rfr")
{
@@ -355,7 +355,7 @@ sub parse_schedule_ccl
}
# Parse the non-schedule communication line
- elsif ($line =~ m/\s*COMM(UNICATION)?\s*:\s*(.*)/i)
+ elsif ($line =~ m/\s*COMM[^\:]*:\s*(.*)/i)
{
if ($type eq "rfr")
{
@@ -519,7 +519,7 @@ sub parse_schedule_at_RFR {
for ($i=0; $i<@block; $i++)
{
$line = @block[$i];
- if ($line =~ m/\s*LANG\s*:\s*FORTRAN\s*$/i)
+ if ($line =~ m/\s*LANG[^\:]*:\s*FORTRAN\s*$/i)
{
$got_it++;
@@ -529,7 +529,7 @@ sub parse_schedule_at_RFR {
$proto = "void $wrapper_file(CCTK_CARGUMENTS);\n";
}
- elsif ($line =~ m/\s*LANG\s*:\s*C\s*$/i)
+ elsif ($line =~ m/\s*LANG[^\:]*:\s*C\s*$/i)
{
$proto = "void $routine(CCTK_CARGUMENTS);\n";
$got_it++;
@@ -546,7 +546,7 @@ sub parse_schedule_at_RFR {
for ($i=0; $i<@block; $i++)
{
$line = @block[$i];
- if ($line =~ m/\s*STORAGE\s*:\s*(.*)\s*$/i)
+ if ($line =~ m/\s*STOR[^\:]*:\s*(.*)\s*$/i)
{
@list = split(",",$1);
foreach $group (@list)
@@ -587,7 +587,7 @@ sub parse_schedule_at_RFR {
for ($i=0; $i<@block; $i++)
{
$line = @block[$i];
- if ($line =~ m/\s*COMM(UNICATION)?\s*:\s*(.*)\s*/i)
+ if ($line =~ m/\s*COMM[^\:]*:\s*(.*)\s*/i)
{
@list = split(",",$2);
foreach $group (@list)
generated by cgit v1.2.3 (git 2.39.1) at 2024-06-26 13:54:17 +0000