Changeset b21d63 in git


Ignore:
Timestamp:
Aug 19, 1999, 4:16:51 PM (25 years ago)
Author:
Hans Schönemann <hannes@…>
Branches:
(u'fieker-DuVal', '117eb8c30fc9e991c4decca4832b1d19036c4c65')(u'spielwiese', 'b4f17ed1d25f93d46dbe29e4b499baecc2fd51bb')
Children:
b0d726595eb00db92f55a59a138a24fdade25eb2
Parents:
64f367415b44843c2181ccef625cc48c48e410b2
Message:
*hannes: cp may not understand -f


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

Legend:

Unmodified
Added
Removed
  • Tst/regress.cmd

    r64f3674 rb21d63  
    22
    33#################################################################
    4 # $Id: regress.cmd,v 1.25 1998-10-27 17:31:13 obachman Exp $
    5 # FILE:    regress.cmd 
     4# $Id: regress.cmd,v 1.26 1999-08-19 14:16:51 hannes Exp $
     5# FILE:    regress.cmd
    66# PURPOSE: Script which runs regress test of Singular
    77# CREATED: 2/16/98
     
    99
    1010#################################################################
    11 # 
     11#
    1212# usage
    13 # 
     13#
    1414sub Usage
    1515{
     
    2626  [-m [crit]]       -- merge status results [of crit] into result file
    2727  [file.lst]        -- read tst files from file.lst
    28   [file.tst]        -- test Singular script file.tst 
     28  [file.tst]        -- test Singular script file.tst
    2929_EOM_
    3030}
    3131
    3232#################################################################
    33 # 
     33#
    3434# used programs
    3535#
     
    6565  $call = "$call > catch_$$";
    6666  & mysystem($call);
    67  
     67
    6868  open(CATCH_FILE, "<catch_$$");
    6969  while (<CATCH_FILE>)
     
    8888
    8989#################################################################
    90 # 
     90#
    9191# the default settings
    9292#
     
    116116
    117117#################################################################
    118 # 
     118#
    119119# auxiallary routines
    120 # 
     120#
    121121
    122122sub Set_withMP
     
    138138  }
    139139}
    140    
    141    
     140
     141
    142142sub MPok
    143143{
    144144  local($root) = $_[0];
    145  
     145
    146146  if (! open(TST_FILE, "<$root.tst"))
    147147  {
     
    164164  local($root) = $_[0];
    165165  local($exit_status);
    166  
    167   # prepare the result files: 
     166
     167  # prepare the result files:
    168168  &mysystem("$cat $root.res | $tr -d '\\013' | $sed $sed_scripts > $root.res.cleaned");
    169169  &mysystem("$cat $root.new.res | $tr -d '\\013' | $sed $sed_scripts > $root.new.res.cleaned");
     
    172172  if ($verbosity > 0 && ! $WINNT)
    173173  {
    174     $exit_status = &mysystem("$diff -w -B $root.res.cleaned $root.new.res.cleaned | $tee $root.diff");
     174    $exit_status = &mysystem("$diff -w -b $root.res.cleaned $root.new.res.cleaned | $tee $root.diff");
    175175  }
    176176  else
    177177  {
    178     $exit_status = &mysystem("$diff -w -B $root.res.cleaned $root.new.res.cleaned > $root.diff 2>&1");
    179   }
    180  
     178    $exit_status = &mysystem("$diff -w -b $root.res.cleaned $root.new.res.cleaned > $root.diff 2>&1");
     179  }
     180
    181181  # clean up time
    182182  &mysystem("$rm -f $root.res.cleaned $root.new.res.cleaned");
    183  
     183
    184184  # there seems to be a bug here somewhere: even if diff reported
    185185  # differenceses and exited with status != 0, then system still
    186186  # returns exit status 0. Hence we manually need to find out whether
    187   # or not differences were reported: 
     187  # or not differences were reported:
    188188  # iff diff-file exists and has non-zero size
    189189  $exit_status = $exit_status || (-e "$root.diff" && -s "$root.diff");
     
    191191  return($exit_status);
    192192}
    193  
     193
    194194sub tst_status_check
    195195{
     
    199199  local($exit_status, $reported) = (0, 0);
    200200  local($error_cause) = "";
    201  
    202   open(RES_FILE, "<$root.stat") || 
     201
     202  open(RES_FILE, "<$root.stat") ||
    203203    return (1, "Can not open $root.stat \n");
    204204  open(NEW_RES_FILE, "<$root.new.stat") ||
     
    209209  $new_line = <NEW_RES_FILE>;
    210210  $line = <RES_FILE>;
    211  
     211
    212212  while ($line && $new_line)
    213213  {
     
    218218      $res = $3;
    219219      if ($res > $mintime_val &&
    220           $new_line =~ /$prefix >> $crit ::.*$hostname:(\d+)/)
    221       {
    222         $new_res = $1;
    223         $res_diff = $new_res - $res;
    224         $res_diff_pc = int((($new_res / $res) - 1)*100);
    225         $res_diff_line =
    226           "$prefix >> $crit :: new:$new_res old:$res diff:$res_diff %:$res_diff_pc";
    227         if ((defined($error{$crit}) &&  $error{$crit}<abs($res_diff_pc))
    228               ||
    229             (defined($report{$crit}) && $report{$crit}<abs($res_diff_pc)))
    230         {
    231           $reported = 1;
    232           print (STATUS_DIFF_FILE "$res_diff_line\n");
    233           print "$res_diff_line\n" if ($verbosity > 0);
    234         }
    235 
    236         if ($exit_status == 0)
    237         {
    238           $exit_status = (defined($error{$crit}) 
    239                           && $error{$crit} < abs($res_diff_pc));
    240           $error_cause = "Status error for $crit at $prefix\n"
    241             if ($exit_status);
    242         }
     220          $new_line =~ /$prefix >> $crit ::.*$hostname:(\d+)/)
     221      {
     222        $new_res = $1;
     223        $res_diff = $new_res - $res;
     224        $res_diff_pc = int((($new_res / $res) - 1)*100);
     225        $res_diff_line =
     226          "$prefix >> $crit :: new:$new_res old:$res diff:$res_diff %:$res_diff_pc";
     227        if ((defined($error{$crit}) &&  $error{$crit}<abs($res_diff_pc))
     228              ||
     229            (defined($report{$crit}) && $report{$crit}<abs($res_diff_pc)))
     230        {
     231          $reported = 1;
     232          print (STATUS_DIFF_FILE "$res_diff_line\n");
     233          print "$res_diff_line\n" if ($verbosity > 0);
     234        }
     235
     236        if ($exit_status == 0)
     237        {
     238          $exit_status = (defined($error{$crit})
     239                          && $error{$crit} < abs($res_diff_pc));
     240          $error_cause = "Status error for $crit at $prefix\n"
     241            if ($exit_status);
     242        }
    243243      }
    244244    }
     
    258258  local($root) = $_[0];
    259259  local($line, $new_line, $crit, $res);
    260  
    261   open(RES_FILE, "<$root.stat") || 
     260
     261  open(RES_FILE, "<$root.stat") ||
    262262    return (1, "Can not open $root.stat \n");
    263263  open(NEW_RES_FILE, "<$root.new.stat") ||
     
    265265  open(TEMP_FILE, ">$root.tmp.stat") ||
    266266    return (1, "Can not open $root.tmp.stat \n");
    267  
     267
    268268  $new_line = <NEW_RES_FILE>;
    269269  $line = <RES_FILE>;
     
    277277      if ($line =~ /$prefix >> $crit ::(.*)$hostname:(\d+)/)
    278278      {
    279         $line =~ s/$hostname:$2/$hostname:$new_res/;
    280         print(TEMP_FILE $line);
     279        $line =~ s/$hostname:$2/$hostname:$new_res/;
     280        print(TEMP_FILE $line);
    281281      }
    282282      elsif ($line =~ /$prefix >> $crit ::(.*)/)
    283283      {
    284         print(TEMP_FILE
    285               "$prefix >> $crit :: $hostname:$new_res $1\n");
     284        print(TEMP_FILE
     285              "$prefix >> $crit :: $hostname:$new_res $1\n");
    286286      }
    287287      else
    288288      {
    289         close(RES_FILE);
    290         close(NEW_RES_FILE);
    291         close(TEMP_FILE);
    292         &mysystem("$rm $root.tmp.stat");
    293         return (1, "Generate before doing a merge\n");
     289        close(RES_FILE);
     290        close(NEW_RES_FILE);
     291        close(TEMP_FILE);
     292        &mysystem("$rm $root.tmp.stat");
     293        return (1, "Generate before doing a merge\n");
    294294      }
    295295    }
    296296    else
    297297    {
    298       print(TEMP_FILE $line);   
     298      print(TEMP_FILE $line);
    299299    }
    300300    $new_line = <NEW_RES_FILE>;
     
    312312  local($root) = $_[0];
    313313  local($system_call, $exit_status, $ignore_pattern, $error_cause);
    314  
     314
    315315  print "--- $root\n" unless ($verbosity == 0);
    316316  # check for existence/readablity of tst and res file
     
    320320    return (1);
    321321  }
    322  
     322
    323323  # ignore MP stuff, if this singular does not have MP
    324324  if (! &MPok($root))
     
    327327    return (0);
    328328  }
    329  
     329
    330330  # generate $root.res
    331331  if ($generate ne "yes")
     
    336336      if ($exit_status)
    337337      {
    338         print (STDERR "Can not decode $root.res.gz.uu\n");
    339         return ($exit_status);
     338        print (STDERR "Can not decode $root.res.gz.uu\n");
     339        return ($exit_status);
    340340      }
    341341    }
     
    359359  # Go Singular, Go!
    360360  $exit_status = &mysystem($system_call);
    361  
     361
    362362  if ($exit_status != 0)
    363363  {
     
    368368    # check for Segment fault in res file
    369369    $exit_status = ! (&mysystem("$grep \"Segment fault\" $root.new.res > /dev/null 2>&1"));
    370    
     370
    371371    if ($exit_status)
    372372    {
     
    378378      if ($generate eq "yes")
    379379      {
    380         &mysystem("$cp $root.new.res $root.res");
    381       }
    382       else 
    383       {
    384         # call Diff
    385         $exit_status = &Diff($root);
    386         if ($exit_status)
    387         {
    388           $error_cause = "Differences in res files";
    389         }
    390         else
    391         {
    392           &mysystem("$rm -f $root.diff");
    393         }
     380        &mysystem("$cp $root.new.res $root.res");
     381      }
     382      else
     383      {
     384        # call Diff
     385        $exit_status = &Diff($root);
     386        if ($exit_status)
     387        {
     388          $error_cause = "Differences in res files";
     389        }
     390        else
     391        {
     392          &mysystem("$rm -f $root.diff");
     393        }
    394394      }
    395395    }
     
    398398  if (%checks && ! $exit_status && $generate ne "yes")
    399399  {
    400     & mysystem("$cp -f tst_status.out $root.new.stat");
     400    & mysystem("$cp tst_status.out $root.new.stat");
    401401    # do status checks
    402402    ($exit_status, $error_cause) = & tst_status_check($root);
    403403  }
    404  
    405  
     404
     405
    406406  # complain even if verbosity == 0
    407407  if ($exit_status)
     
    411411  else
    412412  {
    413    
     413
    414414    #clean up
    415     if ($generate eq "yes") 
    416     {
    417       & mysystem("$cp -f tst_status.out $root.stat");
     415    if ($generate eq "yes")
     416    {
     417      & mysystem("$cp tst_status.out $root.stat");
    418418      if (! $WINNT)
    419419      {
    420         &mysystem("$gzip -cf $root.res | $uuencode $root.res.gz > $root.res.gz.uu");
     420        &mysystem("$gzip -cf $root.res | $uuencode $root.res.gz > $root.res.gz.uu");
    421421      }
    422422      else
    423423      {
    424         # uuencode is broken under windows
    425         print "Warning: Can not generate $root.res.gz.uu under Windows\n";
    426       }
    427      
     424        # uuencode is broken under windows
     425        print "Warning: Can not generate $root.res.gz.uu under Windows\n";
     426      }
     427
    428428    }
    429429    elsif (%merge)
     
    431431      if (! -r "$root.stat")
    432432      {
    433         & mysystem("$cp -f tst_status.out $root.stat");
     433        & mysystem("$cp tst_status.out $root.stat");
    434434      }
    435435      else
    436436      {
    437         & mysystem("$cp -f tst_status.out $root.new.stat");
    438         ($exit_status, $error_cause) = & tst_status_merge($root);
    439 
    440         print (STDERR "Warning: Merge Problems: $error_cause\n")
    441           if ($verbosity > 0 && $exit_status);
     437        & mysystem("$cp tst_status.out $root.new.stat");
     438        ($exit_status, $error_cause) = & tst_status_merge($root);
     439
     440        print (STDERR "Warning: Merge Problems: $error_cause\n")
     441          if ($verbosity > 0 && $exit_status);
    442442      }
    443443    }
     
    446446    {
    447447      &mysystem("$rm -f tst_status.out $root.new.res $root.res $root.diff $root.new.stat");
    448     } 
    449   }
    450  
     448    }
     449  }
     450
    451451  # und tschuess
    452452  return ($exit_status);
     
    455455
    456456#################################################################
    457 # 
     457#
    458458# Main program
    459 # 
     459#
    460460
    461461# process switches
     
    491491      ($crit, $val) = split(/%/, shift);
    492492    }
    493     elsif ($ARGV[0] && 
    494            $ARGV[0] !~ /^-/ && $ARGV[0] !~ /.*\.tst/ && $ARGV[0] !~ /.*\.lst/)
     493    elsif ($ARGV[0] &&
     494           $ARGV[0] !~ /^-/ && $ARGV[0] !~ /.*\.tst/ && $ARGV[0] !~ /.*\.lst/)
    495495    {
    496496      $crit = shift;
     
    503503      $report{"tst_timer"} = $val;
    504504      $report{"tst_timer_1"} = $val;
    505       $checks{"tst_memory_0"} = 1; 
     505      $checks{"tst_memory_0"} = 1;
    506506      $checks{"tst_memory_1"} = 1;
    507       $checks{"tst_memory_2"} =  1; 
    508       $checks{"tst_timer"} =  1; 
    509       $checks{"tst_timer_1"} =  1; 
     507      $checks{"tst_memory_2"} =  1;
     508      $checks{"tst_timer"} =  1;
     509      $checks{"tst_timer_1"} =  1;
    510510    }
    511511    else
     
    523523      ($crit, $val) = split(/%/, shift);
    524524    }
    525     elsif ($ARGV[0] && 
    526             $ARGV[0] !~ /^-/ && $ARGV[0] !~ /.*\.tst/ && $ARGV[0] !~ /.*\.lst/)
     525    elsif ($ARGV[0] &&
     526            $ARGV[0] !~ /^-/ && $ARGV[0] !~ /.*\.tst/ && $ARGV[0] !~ /.*\.lst/)
    527527    {
    528528      $crit = shift;
     
    535535      $error{"tst_timer"} = $val;
    536536      $error{"tst_timer_1"} = $val;
    537       $checks{"tst_memory_0"} = 1; 
     537      $checks{"tst_memory_0"} = 1;
    538538      $checks{"tst_memory_1"} = 1;
    539       $checks{"tst_memory_2"} =  1; 
    540       $checks{"tst_timer"} =  1; 
    541       $checks{"tst_timer_1"} =  1; 
     539      $checks{"tst_memory_2"} =  1;
     540      $checks{"tst_timer"} =  1;
     541      $checks{"tst_timer_1"} =  1;
    542542    }
    543543    else
     
    549549  elsif(/^-m$/)
    550550  {
    551     if ($ARGV[0] && 
    552         $ARGV[0] !~ /^-/ && $ARGV[0] !~ /.*\.tst/ && $ARGV[0] !~ /.*\.lst/)
     551    if ($ARGV[0] &&
     552        $ARGV[0] !~ /^-/ && $ARGV[0] !~ /.*\.tst/ && $ARGV[0] !~ /.*\.lst/)
    553553    {
    554554      $crit = shift;
     
    557557    else
    558558    {
    559       $merge{"tst_memory_0"} = 1; 
     559      $merge{"tst_memory_0"} = 1;
    560560      $merge{"tst_memory_1"} = 1;
    561       $merge{"tst_memory_2"} =  1; 
    562       $merge{"tst_timer"} =  1; 
    563       $merge{"tst_timer_1"} =  1; 
    564     }
    565   }
    566   else 
     561      $merge{"tst_memory_2"} =  1;
     562      $merge{"tst_timer"} =  1;
     563      $merge{"tst_timer_1"} =  1;
     564    }
     565  }
     566  else
    567567  {
    568568    print (STDERR "Unrecognised option: $_\n") && &Usage && die;
     
    603603{
    604604
    605   if ( /^(.*)\.([^\.\/]*)$/ ) 
     605  if ( /^(.*)\.([^\.\/]*)$/ )
    606606  {
    607607    $_ = $1;
     
    609609  }
    610610
    611   if ( /^(.*)\/([^\/]*)$/ ) 
     611  if ( /^(.*)\/([^\/]*)$/ )
    612612  {
    613613    $path = $1;
     
    615615    chdir($path);
    616616    print "cd $path\n" if ($verbosity > 1);
    617   } 
    618   else 
     617  }
     618  else
    619619  {
    620620    $path = "";
     
    623623  $file = "$base.$extension";
    624624  chop ($tst_curr_dir = `pwd`);
    625  
     625
    626626  if ($extension eq "tst")
    627627  {
     
    640640      if (/^;/)          # ignore lines starting with ;
    641641      {
    642         print unless ($verbosity == 0);
    643         next;
     642        print unless ($verbosity == 0);
     643        next;
    644644      }
    645645      next if (/^\s*$/); #ignore whitespaced lines
    646646      chop if (/\n$/);   #chop of \n
    647      
     647
    648648      $_ = $1 if (/^(.*)\.([^\.\/]*)$/ ); # chop of extension
    649       if ( /^(.*)\/([^\/]*)$/ ) 
    650       {
    651         $tst_path = $1;
    652         $tst_base = $2;
     649      if ( /^(.*)\/([^\/]*)$/ )
     650      {
     651        $tst_path = $1;
     652        $tst_base = $2;
    653653        chdir($tst_path);
    654         print "cd $tst_path\n" if ($verbosity > 1);
    655       } 
    656       else 
    657       {
    658         $tst_path = "";
    659         $tst_base = $_;
     654        print "cd $tst_path\n" if ($verbosity > 1);
     655      }
     656      else
     657      {
     658        $tst_path = "";
     659        $tst_base = $_;
    660660      }
    661661
     
    664664      if ($tst_path ne "")
    665665      {
    666         chdir($tst_curr_dir);
    667         print "cd $tst_curr_dir\n" if ($verbosity > 1);
     666        chdir($tst_curr_dir);
     667        print "cd $tst_curr_dir\n" if ($verbosity > 1);
    668668      }
    669669    }
     
    678678  {
    679679    chdir($curr_dir);
    680     print "cd $curr_dir\n" if ($verbosity > 1);   
     680    print "cd $curr_dir\n" if ($verbosity > 1);
    681681  }
    682682}
Note: See TracChangeset for help on using the changeset viewer.