source: git/Tst/regress.cmd @ e36ae54

fieker-DuValspielwiese
Last change on this file since e36ae54 was e36ae54, checked in by Olaf Bachmann <obachman@…>, 26 years ago
* regress.cmd: rm .gz file * added stuff from M. Lamm git-svn-id: file:///usr/local/Singular/svn/trunk@1438 2c84dea3-7e68-4137-9b89-c4e89433aadc
  • Property mode set to 100755
File size: 6.3 KB
Line 
1#!/usr/bin/perl
2
3#################################################################
4# $Id: regress.cmd,v 1.6 1998-04-23 13:40:45 obachman Exp $
5# FILE:    regress.cmd
6# PURPOSE: Script which runs regress test of Singular
7# CREATED: 2/16/98
8# AUTHOR:  obachman@mathematik.uni-kl.de
9
10#################################################################
11#
12# usage
13#
14sub Usage
15{
16  print <<_EOM_
17Usage:
18regress.cmd    -- regress test of Singular
19  [-s <Singular>]  -- use <Singular> as executable to test
20  [-h]             -- print out help and exit
21  [-n]             -- do not ignore output from tst_ignore when diffing
22  [-k]             -- keep result (*.res) files, do not zip original res file
23  [-v num]         -- set verbosity to num (used range 0..3, default: 1)
24  [-g]             -- generate result (*.res) files, only
25  [file.lst]       -- read tst files from file.lst
26  [file.tst]       -- test Singular script file.tst
27_EOM_
28}
29
30#################################################################
31#
32# the default settings
33#
34$singularOptions = "-tqr12345678";
35$ignore = "-I '^\/\/.*used time:' -I '^\/\/.*ignore:' -I '? error occurred in'";
36$keep = "no";
37$verbosity = 1;
38$generate = "no";
39$exit_code = 0;
40$singular = "./Singular";
41if ( (! (-e $singular)) || (! (-x $singular)))
42{
43  $singular = "../Singular";
44}
45
46
47#################################################################
48#
49# used programs
50#
51$diff = "diff";
52$gunzip = "gunzip";
53$gzip = "gzip";
54$rm = "rm";
55$cp = "cp";
56$uuencode = "uuencode";
57$uudecode = "uudecode";
58
59#################################################################
60#
61# tst_check($root)
62#
63sub mysystem
64{
65  local($call) = $_[0];
66  local($exit_status);
67 
68  print "$call\n" if ($verbosity > 1);
69  return (system $call);
70}
71
72sub tst_check
73{
74  local($root) = $_[0];
75  local($system_call, $exit_status, $ignore_pattern);
76
77  print "--- $root\n" unless ($verbosity == 0);
78  # check for existence/readablity of tst and res file
79  if (! (-r "$root.tst"))
80  {
81    print (STDERR "Can not read $root.tst\n");
82    return (1);
83  }
84  if ((! (-r "$root.res")) || (-z "$root.res"))
85  {
86    if ((! (-r "$root.res.gz")) || (-z "$root.res.gz"))
87    {
88      if ((! (-r "$root.res.gz.uu")) || (-z "$root.res.gz.uu"))
89      {
90        if ($generate ne "yes")
91        {
92          print (STDERR "Can not read $root.res[.gz]\n");
93          return (1);
94        }
95      }
96      else
97      {
98        $exit_status
99          = $exit_status || &mysystem("$uudecode -o $root.res.gz $root.res.gz.uu; $gunzip $root.res.gz");
100        if ($exit_status)
101        {
102          print (STDERR "Can not decode $root.res.gz.uu\n");
103          return ($exit_status);
104        }
105      }
106    }
107    else
108    {
109      $exit_status = $exit_status || & mysystem("$gunzip -f -c $root.res.gz > $root.res");
110      if ($exit_status)
111      {
112        print (STDERR "Can not `$gunzip -f -c $root.res.gz > $root.res'\n" );
113        return ($exit_status);
114      }
115    }
116  }
117 
118  # prepare Singular run
119  if ($verbosity > 2)
120  {
121    $system_call = "$singular $singularOptions $root.tst | tee $root.new.res";
122  }
123  else
124  {
125    $system_call = "$singular $singularOptions $root.tst > $root.new.res";
126  }
127  # Go Singular, Go!
128  $exit_status = & mysystem($system_call);
129 
130  #prepare diff call
131  & mysystem("$rm -rf $root.diff");
132  if ($generate eq "yes")
133  {
134    $system_call = "$cp $root.new.res $root.res";
135  }
136  elsif ($verbosity > 0)
137  {
138    $system_call = "$diff $ignore $root.res $root.new.res | tee $root.diff";
139  }
140  else
141  {
142    $system_call = "$diff $ignore $root.res $root.new.res > $root.diff";
143  }
144   
145  $exit_status = $exit_status || & mysystem($system_call);
146  # there seems to be a bug here somewhere: even if diff reported
147  # differenceses and exited with status != 0, then system still
148  # returns exit status 0. Hence we manually need to find out whether
149  # or not differences were reported:
150  # iff diff-file exists and has non-zero size
151  $exit_status = $exit_status || (-e "$root.diff" && -s "$root.diff");
152
153  # complain even if verbosity == 0
154  if ($exit_status && $verbosity == 0)
155  {
156    print (STDERR "---!!! $root\n");
157  }
158
159  #time to clean up
160  if ($keep eq "no" && $exit_status == 0 && $generate ne "yes")
161  {
162    & mysystem("$rm -rf $root.new.res $root.diff");
163    if (-r "$root.res.gz.uu")
164    {
165      & mysystem("$rm -rf $root.res");
166    }
167    else
168    {
169      & mysystem("$gzip -f $root.res; $uuencode $root.res.gz $root.res.gz > $root.res.gz.uu; $rm -rf $root.res.gz");
170    }
171  }
172  elsif ($generate eq "yes")
173  {
174    & mysystem("$gzip -f $root.res; $uuencode $root.res.gz $root.res.gz > $root.res.gz.uu");
175    if ($keep eq "yes")
176    {
177      & mysystem("mv $root.new.res $root.res");
178    }
179    else
180    {
181      & mysystem("$rm -rf $root.new.res $root.res.gz");
182    }
183  }
184 
185  return ($exit_status);
186}
187
188
189#################################################################
190#
191# Main program
192#
193
194# process switches
195while ($ARGV[0] =~ /^-/)
196{
197  $_ = shift;
198  if (/^-s$/)
199  {
200    $singular = shift;
201  }
202  elsif (/^-h$/)
203  {
204    &Usage && exit (0);
205  }
206  elsif (/^-n$/)
207  {
208    $ignore = "";
209  }
210  elsif (/^-k$/)
211  {
212    $keep = "yes";
213  }
214  elsif (/^-g$/)
215  {
216    $generate = "yes";
217  }
218  elsif(/^-v$/)
219  {
220    $verbosity = shift;
221  }
222  else
223  {
224    print (STDERR "Unrecognised option: $_\n") && &Usage && die;
225  }
226}
227
228# if no command line arguments are left, use regress.lst
229if ($#ARGV == -1)
230{
231  $ARGV[0] = "regress.lst";
232}
233
234# make sure $singular exists and is executable
235if ( ! (-e $singular))
236{
237  print (STDERR "Can not find $singular \n") && &Usage && die;
238}
239if (! (-x $singular))
240{
241  print (STDERR "Can not execute $singular \n") && Usage && die;
242}
243
244# now do the work
245foreach (@ARGV)
246{
247  # get root and extension
248  ($extension = $_) =~ s/.*\.([^\.]*)$/$1/;
249  ($root = $_) =~ s/(.*)\.[^\.]*$/$1/;
250
251  if ($extension eq "tst")
252  {
253    $exit_code = & tst_check($root) || $exit_code;
254  }
255  elsif ($extension eq "lst")
256  {
257    if (! open(LST_FILE, "<$_"))
258    {
259      print (STDERR "Can not open $_ for reading\n");
260      $exit_code = 1;
261      next;
262    }
263    while (<LST_FILE>)
264    {
265      if (/^;/)
266      {
267        print unless ($verbosity == 0);
268        next;
269      }
270      next if (/^\s*$/);
271      chop if (/\n$/);
272      ($extension = $_) =~ s/.*\.([^\.]*)$/$1/;
273      ($root = $_) =~ s/(.*)\.[^\.]*$/$1/;
274      $exit_code = & tst_check($root) || $exit_code;
275    }
276    close (LST_FILE);
277  }
278  else
279  {
280    print (STDERR "Unknown extension of $_: Need extension lst or tst\n");
281    $exit_code = 1;
282  }
283}
284
285# Und Tschuess
286exit $exit_code;
287
288
Note: See TracBrowser for help on using the repository browser.