From 50d54a91474ef22beeebd842147974f2a3bdf6b1 Mon Sep 17 00:00:00 2001 From: goodale Date: Thu, 22 Feb 2001 22:01:41 +0000 Subject: Re-indenting and some formatting. Tom git-svn-id: http://svn.cactuscode.org/flesh/trunk@2040 17b73243-c579-4c4c-a9d2-2d5706c11dac --- lib/sbin/Runtest.pl | 477 +++++++++++++++++++++++++++------------------------- 1 file changed, 246 insertions(+), 231 deletions(-) (limited to 'lib') diff --git a/lib/sbin/Runtest.pl b/lib/sbin/Runtest.pl index f9369882..3b434257 100644 --- a/lib/sbin/Runtest.pl +++ b/lib/sbin/Runtest.pl @@ -17,8 +17,8 @@ $ansinormal=""; $ansibold=""; if ($prompt ne "no") { - $ansinormal = "\033[0m"; - $ansibold = "\033[1m"; + $ansinormal = "\033[0m"; + $ansibold = "\033[1m"; } # Work out where the config directory is @@ -73,14 +73,14 @@ $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"; + print "Can't open $scratchdir/ThornList - no thorn tests"; } else { chdir "arrangements"; - + while () { next if (m:^\#:); @@ -89,7 +89,7 @@ else $name =~ /^\s*([^\s]*)\s*/; $T = $1; push(@allthorns, $T); - + $T =~ m:^.*/([^\s]*)\s*:; $database{"\U$T THORN\E"} = $1; $T =~ m:^\s*([^\s]*)/:; @@ -109,12 +109,12 @@ else $number++; } chdir "../../.." || die "Unable to chdir to $thisdir"; - + } $ntests{"$T"} = $number; $database{"\U$T NTESTS\E"} = $number; } - + chdir ".."; } @@ -124,16 +124,16 @@ foreach $t (@testfiles) { $file = "arrangements/$testthorns[$ntests]/test/$t"; open (IN, "<$file") || die "Can not open $file"; - + $processing_active = 0; - + # Give a default test name in case non is specified in the parameter file. $testnames{$ntests} = "$testthorns[$ntests]/test/$t"; - + while () { $line = $_; - + if($processing_active == 1) { if($line =~ m/(.*)\"/) @@ -207,18 +207,18 @@ foreach $t (@testfiles) if ($tests =~ /All/) { - + # Run all parameter files $number_failed=0; $number_zerofiles=0; $number_passed1=0; $number_passed2=0; $ntested = 0; - + foreach $t (@testfiles) { $thorn = $testthorns[$ntested]; - + if ($havethorns{"$t"}) { push(@actually_tested, $testnames[$ntested]); @@ -230,12 +230,12 @@ if ($tests =~ /All/) push(@not_tested_thorns, $thorn); print "Ignoring test '$testnames[$ntested]' from thorn '$thorn' - missing thorns.\n"; } - + $ntested++; } - -# Show the statistics - + + # Show the statistics + print "==================================================\n"; print "All tests run for configuration $config\n\n"; print "Tested: \n"; @@ -247,12 +247,12 @@ if ($tests =~ /All/) print " $thorn [$ntests{\"$thorn\"}]\n"; } } - + print "\n"; print " Total Tests -> $ntests\n"; if ($number_missing > 0) { - print " Number which couldn't be run -> $number_missing\n"; + print " Number which couldn't be run -> $number_missing\n"; } print " Number passed -> $number_passed1\n"; if ($number_passed2 > 0) @@ -260,7 +260,7 @@ 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"; @@ -271,9 +271,9 @@ if ($tests =~ /All/) } if ($number_zerofiles > 0) { - print " Number with no output files -> $number_zerofiles\n"; + print " Number with no output files -> $number_zerofiles\n"; } - + if ($number_missing>0) { print "\n Tests Missed for lack of thorns:\n"; @@ -282,271 +282,286 @@ if ($tests =~ /All/) print " ". $not_tested[$i]." (from ". $not_tested_thorns[$i].")\n"; } } - + print "==================================================\n\n"; } else - + { - -# Show the parameter file menu - + + # Show the parameter file menu + $choice = test01; $ntests = 0; foreach $t (@testfiles) { $t =~ m:([^${sep}]+).par$:; - $num = $1; + $num = $1; $inp{$num} = $t; $testnum[$ntests] = $num; $ntests++; +} +while (!($choice =~ /^q/i) ) +{ + print "\n--- Menu ---\n"; + $sp = " "; + for ($i=0;$i<$ntests;$i++) + { + if($havethorns{$inp{$testnum[$i]}}) + { + $number = $i+1; + } + else + { + $number = "x"; + } + print "[$number] $testthorns[$i] $testnum[$i]: \n \"$testnames[$i]\"\n"; } - while (!($choice =~ /^q/i) ) + print "\n Enter number of test to run (quit to end) : "; + $choice = if ($prompt eq "yes"); + $choice =~ s/\n//; + $choice =~ s/\s//; + print "\n"; + $ip = $inp{$testnum[$choice-1]}; + $thorn = $testthorns[$choice-1]; + if (!($choice =~ m/^q/i || $choice =~ m/^\s*$/)) { - print "\n--- Menu ---\n"; - $sp = " "; - for ($i=0;$i<$ntests;$i++) + if($choice > 0 && $choice <= $ntests) { - if($havethorns{$inp{$testnum[$i]}}) + if($havethorns{$ip}) { - $number = $i+1; + &runtest($ip,$thorn,$choice-1); } else { - $number = "x"; - } - print "[$number] $testthorns[$i] $testnum[$i]: \n \"$testnames[$i]\"\n"; - } - print "\n Enter number of test to run (quit to end) : "; - $choice = if ($prompt eq "yes"); - $choice =~ s/\n//; - $choice =~ s/\s//; - print "\n"; - $ip = $inp{$testnum[$choice-1]}; - $thorn = $testthorns[$choice-1]; - if (!($choice =~ m/^q/i || $choice =~ m/^\s*$/)) - { - if($choice > 0 && $choice <= $ntests) - { - if($havethorns{$ip}) - { - &runtest($ip,$thorn,$choice-1); - } - else - { - print "This test cannot be run - missing thorns\n"; - } + print "This test cannot be run - missing thorns\n"; } } - if (!($choice =~ m/^q/i)) - { - print " Hit return to continue "; - $continue = if ($prompt eq "yes"); - } } + if (!($choice =~ m/^q/i)) + { + print " Hit return to continue "; + $continue = if ($prompt eq "yes"); + } +} - print "\n"; +print "\n"; } -sub runtest { - my ($inpf,$inthorn,$num) = @_; +sub runtest +{ + my ($inpf,$inthorn,$num) = @_; + + # File name from thorn + $inpf = "arrangements/$inthorn/test/$inpf"; + + # Directory for output + $tsttop = ".${sep}TEST${sep}$config"; + mkdir (TEST,0755); + mkdir ($tsttop,0755); + + $tp = $inpf; + $tp =~ s:^.*$sep::; + $tp =~ s/.par//; + + $test_base_dir = $inpf; + $test_base_dir =~ s:[^${sep}]*$::; - # File name from thorn - $inpf = "arrangements/$inthorn/test/$inpf"; + print "Running $tp: $testnames[$num]\n"; - # Directory for output - $tsttop = ".${sep}TEST${sep}$config"; - mkdir (TEST,0755); - mkdir ($tsttop,0755); + unlink(<$tsttop${sep}$tp${sep}*.*>); - $tp = $inpf; - $tp =~ s:^.*$sep::; - $tp =~ s/.par//; - - $test_base_dir = $inpf; - $test_base_dir =~ s:[^${sep}]*$::; + if (! (-e "$current_directory$sep$executable")) + { + if (-e "$current_directory$sep${executable}.exe") + { + $executable .= ".exe"; + } + else + { + die "Cannot locate $executable"; + } + } - print "Running $tp: $testnames[$num]\n"; + $cmd = "($command $current_directory$sep$executable $current_directory$sep$inpf)"; - unlink(<$tsttop${sep}$tp${sep}*.*>); + chdir ($tsttop); - if (! (-e "$current_directory$sep$executable")) + printf "Issuing $cmd\n"; + $retcode = 0; + open (CMD, "$cmd |"); + open (LOG, "> $tp.log"); + + while () + { + print LOG; + + if( /Cactus exiting with return code (.*)/) { - if (-e "$current_directory$sep${executable}.exe") - { - $executable .= ".exe"; - } - else - { - die "Cannot locate $executable"; - } + $retcode = $1 + 0; } + } + close LOG; + close CMD; + $retcode = $? >> 8 if($retcode==0); - $cmd = "($command $current_directory$sep$executable $current_directory$sep$inpf)"; - - chdir ($tsttop); + chdir ("../.."); - printf "Issuing $cmd\n"; - $retcode = 0; - open (CMD, "$cmd |"); - open (LOG, "> $tp.log"); - while () { - print LOG; + if($retcode != 0) + { + 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); + @thorn_failed = (@thorn_failed,$inthorn); + return; + } - if( /Cactus exiting with return code (.*)/){ - $retcode = $1 + 0; - } - } - close LOG; - close CMD; - $retcode = $? >> 8 if($retcode==0); - - chdir ("../.."); - + $indir = $inpf; + $indir =~ s:.par:${sep}:g; + @oldout = <$indir${sep}*.*l>; + $blewit = 0; + $reallyblewit = 0; + $nfiles = 0; - if($retcode != 0) + foreach $file (@oldout) + { + $nfiles ++; + $newfile = $file; + $newfile =~ s:^.*${sep}([^${sep}]+)$:$1:; + $newfile = "$tsttop$sep$tp$sep$newfile"; + # print "Comparing $file with $newfile\n"; + + open (INORIG, "<$file"); + open (INNEW, "<$newfile"); + $nblow = 0; + $nrealblow = 0; + while ($oline = ) { - 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); - @thorn_failed = (@thorn_failed,$inthorn); - return; - } - - $indir = $inpf; - $indir =~ s:.par:${sep}:g; - @oldout = <$indir${sep}*.*l>; - $blewit = 0; - $reallyblewit = 0; - $nfiles = 0; - - foreach $file (@oldout) { - $nfiles ++; - $newfile = $file; - $newfile =~ s:^.*${sep}([^${sep}]+)$:$1:; - $newfile = "$tsttop$sep$tp$sep$newfile"; -# print "Comparing $file with $newfile\n"; - - open (INORIG, "<$file"); - open (INNEW, "<$newfile"); - $nblow = 0; - $nrealblow = 0; - while ($oline = ) { - $nline = ; - # Now lets see if they differ. - if (!($nline eq $oline)) { - -# Check against nans - if ($nline =~ /nan/i) - { - print "****CAUGHT NAN in $newfile****\n"; - $nblow ++; - $nrealblow ++; - } -# Check against inf - elsif ($nline =~ /inf/i) - { - print "****CAUGHT INF in $newfile****\n"; - $nblow ++; - $nrealblow ++; - } - else - { -# This is the new comparison (subtract last two numbers) - ($t1,$v1) = split(' ', $nline); - ($t2,$v2) = split(' ', $oline); -# Make sure that floating point numbers have 'e' if exponential. - $v1 =~ s/[dD]/e/; - $v2 =~ s/[dD]/e/; - - $vdiff = abs($v1 - $v2); - if ($vdiff > 0) { - - # They diff. But do they differ strongly? - $nblow ++; - - $exp = sprintf("%e",$vdiff); - $exp =~ s/^.*e-(\d+)/$1/; - unless ($exp >= $tolerance) { - $nrealblow++; - } - } - } - } + $nline = ; + # Now lets see if they differ. + if (!($nline eq $oline)) + { + + # Check against nans + if ($nline =~ /nan/i) + { + print "****CAUGHT NAN in $newfile****\n"; + $nblow ++; + $nrealblow ++; + } + # Check against inf + elsif ($nline =~ /inf/i) + { + print "****CAUGHT INF in $newfile****\n"; + $nblow ++; + $nrealblow ++; } - if ($nblow != 0) { - $blewit ++; - $stripfile = $newfile; - $stripfile =~ s:^.*${sep}(.*)$:$1:; - if ($nrealblow == 0) { - print " $stripfile differs at machine precision (which is OK!)\n"; - } else { - $reallyblewit ++; - print "Substantial differences detected in $stripfile\n"; - print " $newfile $file\n"; - print " Differ on $nblow lines!\n"; + else + { + # This is the new comparison (subtract last two numbers) + ($t1,$v1) = split(' ', $nline); + ($t2,$v2) = split(' ', $oline); + # Make sure that floating point numbers have 'e' if exponential. + $v1 =~ s/[dD]/e/; + $v2 =~ s/[dD]/e/; + + $vdiff = abs($v1 - $v2); + if ($vdiff > 0) + { + + # They diff. But do they differ strongly? + $nblow ++; + + $exp = sprintf("%e",$vdiff); + $exp =~ s/^.*e-(\d+)/$1/; + unless ($exp >= $tolerance) + { + $nrealblow++; } + } } + } } - if ($nfiles == 0) + if ($nblow != 0) { - printf(" $ansibold WARNING: ZERO files compared ! $ansinormal \n"); - $number_zerofiles++; + $blewit ++; + $stripfile = $newfile; + $stripfile =~ s:^.*${sep}(.*)$:$1:; + if ($nrealblow == 0) + { + print " $stripfile differs at machine precision (which is OK!)\n"; + } + else + { + $reallyblewit ++; + print "Substantial differences detected in $stripfile\n"; + print " $newfile $file\n"; + print " Differ on $nblow lines!\n"; + } } - elsif ($blewit == 0) + } + + if ($nfiles == 0) + { + printf(" $ansibold WARNING: ZERO files compared ! $ansinormal \n"); + $number_zerofiles++; + } + elsif ($blewit == 0) + { + printf(" $ansibold Test succeeded!$ansinormal $nfiles files identical\n"); + $number_passed1++; + } + else + { + if ($reallyblewit == 0) { - printf(" $ansibold Test succeeded!$ansinormal $nfiles files identical\n"); - $number_passed1++; + printf "\n $ansibold Test passed to $tolerance figures:$ansinormal ". + "$nfiles compared, $blewit files differ in the last digits\n"; + $number_passed1++; + $number_passed2++; } else { - if ($reallyblewit == 0) - { - printf "\n $ansibold Test passed to $tolerance figures:$ansinormal ". - "$nfiles compared, $blewit files differ in the last digits\n"; - $number_passed1++; - $number_passed2++; - } else { - printf "\n $ansibold TEST FAILED!!:$ansinormal ". - "$nfiles compared, $blewit files differ, $reallyblewit differ significantly\n"; - $number_failed++; - @which_failed = (@which_failed,$tp); - @thorn_failed = (@thorn_failed,$inthorn); - } + printf "\n $ansibold TEST FAILED!!:$ansinormal ". + "$nfiles compared, $blewit files differ, $reallyblewit differ significantly\n"; + $number_failed++; + @which_failed = (@which_failed,$tp); + @thorn_failed = (@thorn_failed,$inthorn); } - printf ("\n\n"); - + } + printf ("\n\n"); } sub defprompt { - my ($pr, $de) = @_; - my ($res); - - print "$pr [$de] \n"; - print " --> "; - - $res = if ($prompt eq "yes"); - if ($res =~ m/^$/) - { - $res = $de; - } - elsif ($res =~ m/^ $/) - { - $res = ""; - } - $res =~ s/\n//; - print "\n"; - return $res; + my ($pr, $de) = @_; + my ($res); + + print "$pr [$de] \n"; + print " --> "; + + $res = if ($prompt eq "yes"); + if ($res =~ m/^$/) + { + $res = $de; + } + elsif ($res =~ m/^ $/) + { + $res = ""; + } + $res =~ s/\n//; + print "\n"; + return $res; } -sub fpabs { - my ($val) = $_[0]; - $val > 0 ? $val:-$val; +sub fpabs +{ + my ($val) = $_[0]; + $val > 0 ? $val:-$val; } -- cgit v1.2.3