Changeset e960fdf in git


Ignore:
Timestamp:
Jun 30, 1998, 4:47:00 PM (26 years ago)
Author:
Olaf Bachmann <obachman@…>
Branches:
(u'spielwiese', 'fe61d9c35bf7c61f2b6cbf1b56e25e2f08d536cc')
Children:
cb13f08429246123111d9182f006e57b143623af
Parents:
f5e6250cc11d7251f40a4537d4a66cf4f22e3539
Message:
* new regress.cmd


git-svn-id: file:///usr/local/Singular/svn/trunk@2262 2c84dea3-7e68-4137-9b89-c4e89433aadc
File:
1 edited

Legend:

Unmodified
Added
Removed

  • Tst/regress.cmd

    rf5e625 re960fdf  
    22
    33#################################################################
    4 # $Id: regress.cmd,v 1.17 1998-06-19 08:19:11 obachman Exp $
     4# $Id: regress.cmd,v 1.18 1998-06-30 14:47:00 obachman Exp $
    55# FILE:    regress.cmd
    66# PURPOSE: Script which runs regress test of Singular
    … …  
    1717Usage:
    1818regress.cmd    -- regress test of Singular
    19   [-s <Singular>]  -- use <Singular> as executable to test
    20   [-h]             -- print out help and exit
    21   [-k]             -- keep result (*.res) files, do not zip original res file
    22   [-v num]         -- set verbosity to num (used range 0..3, default: 1)
    23   [-g]             -- generate result (*.res.gz.uu) files, only
    24   [file.lst]       -- read tst files from file.lst
    25   [file.tst]       -- test Singular script file.tst
     19  [-s <Singular>]   -- use <Singular> as executable to test
     20  [-h]              -- print out help and exit
     21  [-k]              -- keep all intermediate files
     22  [-v num]          -- set verbosity to num (used range 0..3, default: 1)
     23  [-g]              -- generate result (*.res.gz.uu) files, only
     24  [-r [crit%[val]]] -- report if status differences [of crit] > val (in %)
     25  [-e [crit%[val]]] -- throw error if status difference [of crit] > val (in %)
     26  [-m [crit]]       -- merge status results [of crit] into result file
     27  [file.lst]        -- read tst files from file.lst
     28  [file.tst]        -- test Singular script file.tst
    2629_EOM_
    2730}
    … …  
    4245$cat = "cat";
    4346$tee = "tee";
     47$grep = "grep";
    4448
    4549sub mysystem
    … …  
    5458}
    5559
    56 $WINNT = 1 if (&mysystem("uname -a | grep CYGWIN > /dev/null 2>&1") == 0);
     60sub mysystem_catch
     61{
     62  local($call) = $_[0];
     63  local($output) = "";
     64
     65  $call = "$call > catch_$$";
     66  mysystem($call);
     67 
     68  open(CATCH_FILE, "<catch_$$");
     69  while (<CATCH_FILE>)
     70  {
     71    $output = $output.$_;
     72  }
     73  close(CATCH_FILE);
     74  mysystem("$rm -f catch_$$");
     75  return $output;
     76}
     77
     78$WINNT = 1 if (&mysystem("uname -a | $grep CYGWIN > /dev/null 2>&1") == 0);
    5779if ($WINNT)
    5880{
    … …  
    6991# the default settings
    7092#
    71 $singularOptions = "-teqr12345678";
     93$singularOptions = "--ticks-per-sec=10 -teqr12345678";
    7294$keep = "no";
    7395$verbosity = 1;
    … …  
    83105}
    84106# sed scripts which are applied to res files before they are diff'ed
    85 $sed_scripts = "-e '/^\\/\\/.*used time:/d' -e '/^\\/\\/.*ignore:/d' -e '/error occurred in/d'";
    86 
    87 
    88 
     107$sed_scripts = "-e '/\\/\\/.*used time:/d' -e '/\\/\\/.*ignore:/d' -e '/error occurred in/d'";
     108# default value (in %) above which differences are reported on -r
     109$report_val = 10;
     110# default value (in %) above which differences cause an error on -e
     111$error_val = 10;
     112$hostname = &mysystem_catch("hostname");
     113chop $hostname;
    89114
    90115#################################################################
    … …  
    92117# auxiallary routines
    93118#
     119
    94120sub Set_withMP
    95121{
    … …  
    131157  return (1);
    132158}
    133  
     159
    134160sub Diff
    135161{
    … …  
    152178 
    153179  # clean up time
    154   &mysystem("$rm -f $root.res.cleaned $root.new.res.cleaned");
     180#  &mysystem("$rm -f $root.res.cleaned $root.new.res.cleaned");
    155181 
    156182  # there seems to be a bug here somewhere: even if diff reported
    … …  
    164190}
    165191 
     192sub tst_status_check
     193{
     194  local($root) = $_[0];
     195  local($line,$new_line,$prefix,$crit,$res,$new_res);
     196  local($res_diff,$res_diff_pc,$res_diff_line);
     197  local($exit_status) = 0;
     198  local($error_cause) = "";
     199 
     200  open(RES_FILE, "<$root.res");
     201  open(NEW_RES_FILE, "<$root.new.res");
     202  open(STATUS_DIFF_FILE, ">$root.status.diff");
     203  $new_line = <NEW_RES_FILE>;
     204  $line = <RES_FILE>;
     205  while ($line && $new_line)
     206  {
     207    if ($line =~ /^STDIN.*(\d+)>/)
     208    {
     209      $prefix = "STDIN $1>";
     210    }
     211    elsif ($line =~ /\/\/.*ignore:(\w+).*$hostname:(\d+)/ && $checks{$1})
     212    {
     213      $crit = $1;
     214      $res = $2;
     215      if ($line =~ /\/\/.*ignore:$crit.*$hostname:(\d+)/)
     216      {
     217        $new_res = $1;
     218        $res_diff = $res - $new_res;
     219        $res_diff_pc = $res_diff / $res unless ($res == 0);
     220        $res_diff_pc = - $res_diff_pc if ($res_diff_pc < 0);
     221        $res_diff_line =
     222          "$prefix $crit res:$res new:$new_res diff:$res_diff %:$res_diff_pc";
     223        print (STATUS_DIFF_FILE "$res_diff_line\n")
     224          if ($error{$crit} < $res_diff_pc || $report{$crit} < $res_diff_pc);
     225       
     226        print "$res_diff_line\n"
     227          if ($verbosity > 0 &&
     228              ($error{$crit} < $res_diff_pc || $report{$crit} < $res_diff_pc));
     229        if ($exit_status == 0)
     230        {
     231          $exit_status = $exit_status || ($error{$crit} < $res_diff_pc);
     232          $error_cause = "Status error for $crit at $prefix\n"
     233            if ($exit_status);
     234        }
     235      }
     236    }
     237    $new_line = <NEW_RES_FILE>;
     238    $line = <RES_FILE>;
     239  }
     240  close(RES_FILE);
     241  close(NEW_RES_FILE);
     242  close(STATUS_DIFF_FILE);
     243  mysystem("rm -f $root.status.diff")
     244    if ($exit_status == 0 && $keep ne "yes");
     245 
     246  return ($exit_status, $error_cause);
     247}
     248
     249sub tst_status_merge
     250{
     251  local($root) = $_[0];
     252  local($line, $new_line, $crit, $res);
     253 
     254  open(RES_FILE, "<$root.res");
     255  open(NEW_RES_FILE, "<$root.new.res");
     256  open(TEMP_FILE, ">$root.tmp.res");
     257  $new_line = <NEW_RES_FILE>;
     258  $line = <RES_FILE>;
     259  while ($line)
     260  {
     261    if ($new_line =~ /\/\/.*ignore:(\w+).*$hostname:(\d+)/ && $merge{$1})
     262    {
     263      $crit = $1;
     264      $new_res = $2;
     265      if ($line =~ /(.*)\/\/(.*)ignore:$crit(.*)$hostname:(\d+)(.*)/)
     266      {
     267        print(TEMP_FILE
     268              "$1//$2ignore:$crit$3$hostname:$new_res$4");
     269      }
     270      elsif ($line =~ /(.*)\/\/(.*)ignore:$crit(.*)/)
     271      {
     272        print(TEMP_FILE
     273              "$1//$2ignore:$crit$3 $hostname:$new_res\n");
     274      }
     275      else
     276      {
     277        print "Warning: Merge problems: Generate before doing a merge"
     278          if ($verbosity > 0);
     279        print(TEMP_FILE $line);
     280      }
     281    }
     282    else
     283    {
     284      print(TEMP_FILE $line);   
     285    }
     286    $new_line = <NEW_RES_FILE>;
     287    $line = <RES_FILE>;
     288  }
     289  close(RES_FILE);
     290  close(NEW_RES_FILE);
     291  close(TEMP_FILE);
     292  mysystem("$mv $root.tmp.res $root.res")
     293}
     294
    166295sub tst_check
    167296{
    168297  local($root) = $_[0];
    169   local($system_call, $exit_status, $ignore_pattern);
    170 
     298  local($system_call, $exit_status, $ignore_pattern, $error_cause);
     299 
    171300  print "--- $root\n" unless ($verbosity == 0);
    172301  # check for existence/readablity of tst and res file
    … …  
    176305    return (1);
    177306  }
    178 
     307 
    179308  # ignore MP stuff, if this singular does not have MP
    180309  if (! &MPok($root))
    … …  
    183312    return (0);
    184313  }
    185 
     314 
    186315  # generate $root.res
    187316  if ($generate ne "yes")
    … …  
    202331    }
    203332  }
    204  
    205    
     333
    206334  # prepare Singular run
    207335  if ($verbosity > 2 && !$WINNT)
    … …  
    216344  $exit_status = &mysystem($system_call);
    217345 
    218   # prepare diff call
    219   &mysystem("$rm -f $root.diff");
    220   if ($generate eq "yes")
    221   {
    222     if ($exit_status == 0)
    223     {
    224       &mysystem("$cp $root.new.res $root.res");
    225     }
    226   }
    227   else
    228   {
    229     # call Diff
    230     $exit_status = &Diff($root) || $exit_status;
    231   }
     346  if ($exit_status != 0)
     347  {
     348    $error_cause = "Singular call exited with status != 0";
     349  }
     350  else
     351  {
     352    # check for Segment fault in res file
     353    $exit_status = ! (&mysystem("$grep \"Segment fault\" $root.new.res > /dev/null 2>&1"));
     354   
     355    if ($exit_status)
     356    {
     357      $error_cause = "Segment fault";
     358    }
     359    else
     360    {
     361      &mysystem("$rm -f $root.diff");
     362      if ($generate eq "yes")
     363      {
     364        &mysystem("$cp $root.new.res $root.res");
     365      }
     366      else
     367      {
     368        # call Diff
     369        $exit_status = &Diff($root);
     370        if ($exit_status)
     371        {
     372          $error_cause = "Differences in res files";
     373        }
     374      }
     375    }
     376  }
     377
     378  # do status checks
     379  ($exit_status, $error_cause) = & tst_status_check($root)
     380    if (%checks && ! $exit_status && $generate ne "yes");
    232381 
    233382  # complain even if verbosity == 0
    234   if ($exit_status && $verbosity == 0)
    235   {
    236     print (STDERR "!!! $root\n");
    237   }
    238 
    239   #time to clean up
    240   if ($keep eq "no" && $exit_status == 0 && $generate ne "yes")
    241   {
    242     &mysystem("$rm -rf $root.new.res $root.diff");
    243     &mysystem("$rm -rf $root.res") if (-r "$root.res.gz.uu")
    244   }
    245   elsif ($generate eq "yes" && $exit_status == 0)
    246   {
    247     if (! $WINNT)
    248     {
    249       &mysystem("$gzip -f $root.res; $uuencode $root.res.gz $root.res.gz > $root.res.gz.uu; $rm -rf $root.res.gz $root.diff");
    250     }
    251     else
    252     {
    253       # uuencode is broken under windows
    254       print "Warning: Can not generate $root.res.gz.uu under Windows\n";
    255     }
    256     if ($keep eq "yes")
    257     {
    258       &mysystem("$mv $root.new.res $root.res");
    259     }
    260     else
    261     {
    262       &mysystem("$rm -f $root.new.res");
    263     }
     383  if ($exit_status)
     384  {
     385    print (STDERR "!!! $root : $error_cause\n");
     386  }
     387  else
     388  {
     389   
     390    #clean up
     391    if ($generate eq "yes" || %merge)
     392    {
     393      if (! $WINNT)
     394      {
     395        & tst_status_merge($root) if (%merge);
     396        &mysystem("$gzip -cf $root.res | $uuencode $root.res.gz > $root.res.gz.uu");
     397      }
     398      else
     399      {
     400        # uuencode is broken under windows
     401        print "Warning: Can not generate $root.res.gz.uu under Windows\n";
     402      }
     403    }
     404   
     405    if ($keep ne "yes")
     406    {
     407      &mysystem("$rm -f $root.new.res $root.res $root.diff");
     408    }
    264409  }
    265410 
    … …  
    297442  {
    298443    $verbosity = shift;
     444  }
     445  elsif(/^-r$/)
     446  {
     447    $crit = "all";
     448    $val = $report_val;
     449    if ($ARGV[0] =~ /.*%.*/)
     450    {
     451      ($crit, $val) = split(/%/, shift);
     452    }
     453    elsif ($ARGV[0] &&
     454           $ARGV[0] !~ /^-/ && $ARGV[0] !~ /.*\.tst/ && $ARGV[0] !~ /.*\.lst/)
     455    {
     456      $crit = shift;
     457    }
     458    if ($crit eq "all")
     459    {
     460      $report{"tst_memory_0"} = $val;
     461      $report{"tst_memory_1"} = $val;
     462      $report{"tst_memory_2"} = $val;
     463      $report{"tst_timer"} = $val;
     464      $report{"tst_timer_1"} = $val;
     465      $checks{"tst_memory_0"} = 1;
     466      $checks{"tst_memory_1"} = 1;
     467      $checks{"tst_memory_2"} =  1;
     468      $checks{"tst_timer"} =  1;
     469      $checks{"tst_timer_1"} =  1;
     470    }
     471    else
     472    {
     473      $report{$crit} = $val;
     474      $checks{$crit} = 1;
     475    }
     476  }
     477  elsif(/^-e$/)
     478  {
     479    $crit = "all";
     480    $val = $error_val;
     481    if ($ARGV[0] =~ /.*%.*/)
     482    {
     483      ($crit, $val) = split(/%/, shift);
     484    }
     485    elsif ($ARGV[0] &&
     486            $ARGV[0] !~ /^-/ && $ARGV[0] !~ /.*\.tst/ && $ARGV[0] !~ /.*\.lst/)
     487    {
     488      $crit = shift;
     489    }
     490    if ($crit eq "all")
     491    {
     492      $error{"tst_memory_0"} = $val;
     493      $error{"tst_memory_1"} = $val;
     494      $error{"tst_memory_2"} = $val;
     495      $error{"tst_timer"} = $val;
     496      $error{"tst_timer_1"} = $val;
     497      $checks{"tst_memory_0"} = 1;
     498      $checks{"tst_memory_1"} = 1;
     499      $checks{"tst_memory_2"} =  1;
     500      $checks{"tst_timer"} =  1;
     501      $checks{"tst_timer_1"} =  1;
     502    }
     503    else
     504    {
     505      $error{$crit} = $val;
     506      $checks{$crit} = 1;
     507    }
     508  }
     509  elsif(/^-m$/)
     510  {
     511    if ($ARGV[0] &&
     512        $ARGV[0] !~ /^-/ && $ARGV[0] !~ /.*\.tst/ && $ARGV[0] !~ /.*\.lst/)
     513    {
     514      $crit = shift;
     515      $merge{$crit} = 1;
     516    }
     517    else
     518    {
     519      $merge{"tst_memory_0"} = 1;
     520      $merge{"tst_memory_1"} = 1;
     521      $merge{"tst_memory_2"} =  1;
     522      $merge{"tst_timer"} =  1;
     523      $merge{"tst_timer_1"} =  1;
     524    }
    299525  }
    300526  else
Note: See TracChangeset for help on using the changeset viewer.