Changeset 31f293 in git for Tst/regress.cmd


Ignore:
Timestamp:
Aug 14, 2000, 1:27:06 PM (24 years ago)
Author:
Olaf Bachmann <obachman@…>
Branches:
(u'spielwiese', 'fe61d9c35bf7c61f2b6cbf1b56e25e2f08d536cc')
Children:
1d397e3baca9e3cbe1682840b6ec2393adb0c6b1
Parents:
e9ee7b4d7fb035ff718497da10e3e1b442698d3b
Message:
* better stats


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

Legend:

Unmodified
Added
Removed

  • Tst/regress.cmd

    re9ee7b r31f293  
    22
    33#################################################################
    4 # $Id: regress.cmd,v 1.31 1999-12-08 23:52:38 obachman Exp $
     4# $Id: regress.cmd,v 1.32 2000-08-14 11:27:06 obachman Exp $
    55# FILE:    regress.cmd
    66# PURPOSE: Script which runs regress test of Singular
    … …  
    2323  [-g]              -- generate result (*.res.gz.uu) files, only
    2424  [-r [crit%[val]]] -- report if status differences [of crit] > val (in %)
     25  [-c regexp]       -- when comparing results, version must match this regexp
    2526  [-e [crit%[val]]] -- throw error if status difference [of crit] > val (in %)
    26   [-m [crit]]       -- merge status results [of crit] into result file
     27  [-a [crit]]       -- add status results [of crit] to result file
     28  [-m]              -- add status result for current version to result file
    2729  [-t]              -- compute and call mtrack at the end, no diffs
    2830  [file.lst]        -- read tst files from file.lst
    … …  
    114116}
    115117# sed scripts which are applied to res files before they are diff'ed
    116 $sed_scripts = "-e '/used time:/d' -e '/tst_ignore:/d' -e '/Id:/d' -e '/error occurred in/d'";
     118$sed_scripts = "-e '/used time:/d' -e '/tst_ignore:/d' -e '/Id:/d' -e '/error occurred in/d' -e '/tst_status/d' -e'/init >>/d'";
    117119# default value (in %) above which differences are reported on -r
    118120$report_val = 5;
    … …  
    129131#
    130132
     133sub GetSingularVersionDate
     134{
     135  &mysystem("$singular -t -v --execute=\"exit;\"> SingularVersionDate");
     136  open(FD, "<SingularVersionDate");
     137  while (<FD>)
     138  {
     139    $singular_uname = (/for\s+([^\s]*)\s+/ ? $1 : "uname");
     140    $singular_version = (/version\s+([^\s]*)\s+/ ? $1 : "0-0-0");
     141    $singular_date = (/\((.*)\)/ ? $1 : "1970010100");
     142    $this_time = time;
     143    last;
     144  }
     145  close(FD);
     146}
     147
    131148sub Set_withMP
    132149{
    … …  
    206223  local($line,$new_line,$prefix,$crit,$res,$new_res);
    207224  local($res_diff,$res_diff_pc,$res_diff_line);
    208   local($exit_status, $reported) = (0, 0);
     225  my($exit_status, $reported) = (0, 0);
    209226  local($error_cause) = "";
    210227
    … …  
    216233    return (1, "Can not open $root.stat.sdiff \n");
    217234
    218   $new_line = <NEW_RES_FILE>;
    219   $line = <RES_FILE>;
    220 
    221   while ($line && $new_line)
    222   {
    223     if ($line =~ /(\d+) >> (\w+) ::.*$hostname:(\d+)/ && $checks{$2})
    224     {
    225       $prefix = $1;
    226       $crit = $2;
    227       $res = $3;
    228       if ($res > $mintime_val &&
    229           $new_line =~ /$prefix >> $crit ::.*$hostname:(\d+)/)
    230       {
    231         $new_res = $1;
    232         $res_diff = $new_res - $res;
    233         $res_diff_pc = int((($new_res / $res) - 1)*100);
    234         $res_diff_line =
    235           "$prefix >> $crit :: new:$new_res old:$res diff:$res_diff %:$res_diff_pc";
    236         if ((defined($error{$crit}) &&  $error{$crit}<abs($res_diff_pc))
    237               ||
    238             (defined($report{$crit}) && $report{$crit}<abs($res_diff_pc)))
    239         {
    240           $reported = 1;
    241           print (STATUS_DIFF_FILE "$res_diff_line\n");
    242           print "$res_diff_line\n" if ($verbosity > 0);
    243         }
    244 
    245         if ($exit_status == 0)
    246         {
    247           $exit_status = (defined($error{$crit})
    248                           && $error{$crit} < abs($res_diff_pc));
    249           $error_cause = "Status error for $crit at $prefix\n"
    250             if ($exit_status);
    251         }
    252       }
    253     }
    254     $new_line = <NEW_RES_FILE>;
    255     $line = <RES_FILE>;
     235  while (1)
     236  {
     237    while ($new_line = <NEW_RES_FILE>)
     238    {
     239      last if $new_line =~ /(\d+) >> (\w+) ::.*$hostname:(\d+)/ && $checks{$2};
     240    }
     241    last unless $new_line =~ /(\d+) >> (\w+) ::.*$hostname:(\d+)/;
     242    $prefix = $1;
     243    $crit = $2;
     244    $new_res = $3;
     245    next unless $new_res > $mintime_val;
     246   
     247    while ($line = <RES_FILE>)
     248    {
     249      last if $line =~ /$prefix >> $crit ::.*?$hostname:(\d+)/;
     250    }
     251    last unless $line =~ /$prefix >> $crit ::.*?$hostname:(\d+)/;
     252    my $res_version;
     253    $res = 0;
     254
     255    # search for smallest
     256    while ($line =~ /([^\s]*)$hostname:(\d+)/g)
     257    {
     258      my $this_res = $2;
     259      my $this_res_version = $1;
     260      if ((!$res || $this_res <= $res) && (!$status_check_regexp  || $this_res_version =~ /$status_check_regexp/))
     261      {
     262        $res = $this_res;
     263        $res_version = $this_res_version;
     264      }
     265    }
     266    next unless $res;
     267    $res_diff = $new_res - $res;
     268    $res_diff_pc = int((($new_res / $res) - 1)*100);
     269    $res_diff_line =
     270      "$prefix >> $crit :: new:$new_res old:$res_version$res diff:$res_diff %:$res_diff_pc\n";
     271    print STATUS_DIFF_FILE $res_diff_line;
     272   
     273    if ((defined($error{$crit}) &&  $error{$crit}<abs($res_diff_pc))
     274        ||
     275        (defined($report{$crit}) && $report{$crit}<abs($res_diff_pc)))
     276    {
     277      print "$prefix >> $crit :: new:$new_res old:$res diff:$res_diff %:$res_diff_pc\n"
     278        if ($verbosity > 0);
     279    }
     280   
     281    if ($exit_status == 0)
     282    {
     283      $exit_status = (defined($error{$crit})
     284                      && $error{$crit} < abs($res_diff_pc));
     285      $error_cause = "Status error for $crit at $prefix\n"
     286        if ($exit_status);
     287    }
    256288  }
    257289  close(RES_FILE);
    258290  close(NEW_RES_FILE);
    259291  close(STATUS_DIFF_FILE);
    260   mysystem("rm -f $root.stat.sdiff")
    261     if ($reported == 0 &&  $exit_status == 0 && $keep ne "yes");
    262292  return ($exit_status, $error_cause);
    263293}
    … …  
    267297  local($root) = $_[0];
    268298  local($line, $new_line, $crit, $res);
     299
     300  GetSingularVersionDate()
     301    unless $singular_version;
     302
     303  if (! -e "$root.stat")
     304  {
     305    open(RES_FILE, ">$root.stat") ||
     306      return (1, "Can not open $root.stat \n");
     307    open(NEW_RES_FILE, "<$root.new.stat") ||
     308      return (1, "Can not open $root.new.stat \n");
     309
     310    while (<NEW_RES_FILE>)
     311    {
     312      if (/(\d+) >> (\w+) :: /)
     313      {
     314        s/$hostname:(\d+)/$this_time:$singular_date:$singular_version:$singular_uname:$hostname:$1/g;
     315        print RES_FILE $_;
     316      }
     317    }
     318    close(RES_FILE);
     319    close(NEW_RES_FILE);
     320    return;
     321  }
    269322
    270323  open(RES_FILE, "<$root.stat") ||
    … …  
    275328    return (1, "Can not open $root.tmp.stat \n");
    276329
    277   $new_line = <NEW_RES_FILE>;
    278   $line = <RES_FILE>;
    279   while ($line)
    280   {
    281     if ($new_line =~ /(\d+) >> (\w+) ::.*$hostname:(\d+)/ && $merge{$2})
    282     {
    283       $prefix = $1;
    284       $crit = $2;
    285       $new_res = $3;
    286       if ($line =~ /$prefix >> $crit ::(.*)$hostname:(\d+)/)
    287       {
    288         $line =~ s/$hostname:$2/$hostname:$new_res/;
    289         print(TEMP_FILE $line);
    290       }
    291       elsif ($line =~ /$prefix >> $crit ::(.*)/)
    292       {
    293         print(TEMP_FILE
    294               "$prefix >> $crit :: $hostname:$new_res $1\n");
    295       }
    296       else
    297       {
    298         close(RES_FILE);
    299         close(NEW_RES_FILE);
    300         close(TEMP_FILE);
    301         &mysystem("$rm $root.tmp.stat");
    302         return (1, "Generate before doing a merge\n");
    303       }
     330  while (1)
     331  {
     332    while (($new_line = <NEW_RES_FILE>) && $new_line !~ /(\d+) >> (\w+) ::/){}
     333    last unless $new_line =~ /(\d+) >> (\w+) ::.*$hostname:(\d+)/;
     334    my $prefix = $1;
     335    my $crit = $2;
     336    my $new_res = "$this_time:$singular_date:$singular_version:$singular_uname:$hostname:$3";
     337    while (($line = <RES_FILE>) && $line !~ /$prefix >> $crit ::/){}
     338    unless ($line)
     339    {
     340      close(RES_FILE);
     341      close(NEW_RES_FILE);
     342      close(TEMP_FILE);
     343      &mysystem("$rm $root.tmp.stat");
     344      return (1, "Can not find '$prefix >> $crit' in $root.stat\n");
     345    }
     346    if ($merge_version)
     347    {
     348      $line =~ s/[^ ]*:$singular_version:$singular_uname:$hostname:\d+//g;
     349      chop $line;
     350      $line .= " $new_res\n";
    304351    }
    305352    else
    306353    {
    307       print(TEMP_FILE $line);
    308     }
    309     $new_line = <NEW_RES_FILE>;
    310     $line = <RES_FILE>;
    311   }
     354      chop $line;
     355      $line .= " $new_res\n";
     356    }
     357    print TEMP_FILE $line;
     358  }
     359 
    312360  close(RES_FILE);
    313361  close(NEW_RES_FILE);
    314362  close(TEMP_FILE);
    315363  &mysystem("$mv -f $root.tmp.stat $root.stat");
    316   &mysystem("$rm -f $root.new.stat $root.stat.sdiff");
     364  &mysystem("$rm -f $root.new.stat $root.stat.sdiff") unless $keep eq "yes";
     365  return ;
    317366}
    318367
    … …  
    356405  }
    357406
    358   &mysystem("$rm -f tst_status.out");
    359407  my $resfile = "$root.new.res";
    360408  $resfile = "$root.mtrack.res" if ($mtrack);
    361  
     409  my $statfile = "$root.new.stat";
     410  &mysystem("$rm -f $statfile");
    362411  if ($mtrack)
    363412  {
    … …  
    369418  else
    370419  {
     420   
    371421    # prepare Singular run
    372422    if ($verbosity > 2 && !$WINNT)
    373423    {
    374       $system_call = "$cat $root.tst | $singular $singularOptions | $tee $resfile";
     424      $system_call = "$cat $root.tst | $singular --execute 'string tst_status_file=\"$statfile\";' $singularOptions | $tee $resfile";
    375425    }
    376426    else
    377427    {
    378       $system_call = "$cat $root.tst | $singular $singularOptions > $resfile 2>&1";
     428      $system_call = "$cat $root.tst | $singular --execute 'string tst_status_file=\"$statfile\";' $singularOptions > $resfile 2>&1";
    379429    }
    380430  }
    … …  
    418468  }
    419469
     470  mysystem("mv tst_status.out $statfile")
     471    if (! -e $statfile && -e "tst_status.out");
     472
    420473  if (%checks && ! $exit_status && $generate ne "yes" && ! $mtrack)
    421474  {
    422     if (-e "tst_status.out")
    423     {
    424       & mysystem("$cp tst_status.out $root.new.stat");
     475    if (-e "$statfile")
     476    {
    425477      # do status checks
    426478      ($exit_status, $error_cause) = & tst_status_check($root);
    … …  
    428480    else
    429481    {
    430       print "Warning: no file tst_status.out\n";
     482      print "Warning: no file $statfile\n";
    431483    }
    432484  }
    … …  
    445497      if ($generate eq "yes")
    446498      {
    447         & mysystem("$cp tst_status.out $root.stat");
     499        mysystem("$rm -f $root.stat") unless %merge;
     500        ($exit_status, $error_cause) = tst_status_merge($root);
    448501        if (! $WINNT)
    449502        {
    … …  
    455508          print "Warning: Can not generate $root.res.gz.uu under Windows\n";
    456509        }
    457        
    458510      }
    459511      elsif (%merge)
    460512      {
    461         if (! -r "$root.stat")
    462         {
    463           & mysystem("$cp tst_status.out $root.stat");
    464         }
    465         else
    466         {
    467           & mysystem("$cp tst_status.out $root.new.stat");
    468           ($exit_status, $error_cause) = & tst_status_merge($root);
     513        ($exit_status, $error_cause) = & tst_status_merge($root);
    469514         
    470           print (STDERR "Warning: Merge Problems: $error_cause\n")
    471             if ($verbosity > 0 && $exit_status);
    472         }
     515        print (STDERR "Warning: Merge Problems: $error_cause\n")
     516          if ($verbosity > 0 && $exit_status);
    473517      }
    474518    }
    … …  
    580624    }
    581625  }
    582   elsif(/^-m$/)
    583   {
     626  elsif(/^-a/ || /^-m/)
     627  {
     628    $merge_version = 1 if /^-m/;
    584629    if ($ARGV[0] &&
    585630        $ARGV[0] !~ /^-/ && $ARGV[0] !~ /.*\.tst/ && $ARGV[0] !~ /.*\.lst/)
    … …  
    597642    }
    598643  }
     644  elsif (/^-c/)
     645  {
     646    $status_check_regexp = shift;
     647  }
    599648  else
    600649  {
Note: See TracChangeset for help on using the changeset viewer.