source: git/Tst/regress.cmd @ 887c937

spielwiese
Last change on this file since 887c937 was 887c937, checked in by Olaf Bachmann <obachman@…>, 25 years ago
* better cleanup on -g git-svn-id: file:///usr/local/Singular/svn/trunk@1579 2c84dea3-7e68-4137-9b89-c4e89433aadc
  • Property mode set to 100755
File size: 6.0 KB
Line 
1#!/usr/bin/perl
2
3#################################################################
4# $Id: regress.cmd,v 1.8 1998-05-03 13:11:26 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 ($generate ne "yes")
85  {
86    if ((-r "$root.res.gz.uu") && ! ( -z "$root.res.gz.uu"))
87    {
88      $exit_status
89        = $exit_status || &mysystem("$uudecode -o $root.res.gz $root.res.gz.uu; $gunzip -f $root.res.gz");
90      if ($exit_status)
91      {
92        print (STDERR "Can not decode $root.res.gz.uu\n");
93        return ($exit_status);
94      }
95    }
96    elsif (! (-r "$root.res") || ( -z "$root.res"))
97    {
98      print (STDERR "Can not read $root.res[.gz.uu]\n");
99      return (1);
100     
101    }
102  }
103 
104  # prepare Singular run
105  if ($verbosity > 2)
106  {
107    $system_call = "$singular $singularOptions $root.tst | tee $root.new.res";
108  }
109  else
110  {
111    $system_call = "$singular $singularOptions $root.tst > $root.new.res";
112  }
113  # Go Singular, Go!
114  $exit_status = & mysystem($system_call);
115 
116  #prepare diff call
117  & mysystem("$rm -rf $root.diff");
118  if ($generate eq "yes")
119  {
120    $system_call = "$cp $root.new.res $root.res";
121  }
122  elsif ($verbosity > 0)
123  {
124    $system_call = "$diff $ignore $root.res $root.new.res | tee $root.diff";
125  }
126  else
127  {
128    $system_call = "$diff $ignore $root.res $root.new.res > $root.diff";
129  }
130   
131  $exit_status = $exit_status || & mysystem($system_call);
132  # there seems to be a bug here somewhere: even if diff reported
133  # differenceses and exited with status != 0, then system still
134  # returns exit status 0. Hence we manually need to find out whether
135  # or not differences were reported:
136  # iff diff-file exists and has non-zero size
137  $exit_status = $exit_status || (-e "$root.diff" && -s "$root.diff");
138
139  # complain even if verbosity == 0
140  if ($exit_status && $verbosity == 0)
141  {
142    print (STDERR "---!!! $root\n");
143  }
144
145  #time to clean up
146  if ($keep eq "no" && $exit_status == 0 && $generate ne "yes")
147  {
148    & mysystem("$rm -rf $root.new.res $root.diff");
149    if (-r "$root.res.gz.uu")
150    {
151      & mysystem("$rm -rf $root.res");
152    }
153    else
154    {
155      & mysystem("$gzip -f $root.res; $uuencode $root.res.gz $root.res.gz > $root.res.gz.uu; $rm -rf $root.res.gz");
156    }
157  }
158  elsif ($generate eq "yes")
159  {
160    & mysystem("$gzip -f $root.res; $uuencode $root.res.gz $root.res.gz > $root.res.gz.uu; $rm -rf $root.res.gz $root.new.res $root.diff");
161    if ($keep eq "yes")
162    {
163      & mysystem("mv $root.new.res $root.res");
164    }
165  }
166 
167  return ($exit_status);
168}
169
170
171#################################################################
172#
173# Main program
174#
175
176# process switches
177while ($ARGV[0] =~ /^-/)
178{
179  $_ = shift;
180  if (/^-s$/)
181  {
182    $singular = shift;
183  }
184  elsif (/^-h$/)
185  {
186    &Usage && exit (0);
187  }
188  elsif (/^-n$/)
189  {
190    $ignore = "";
191  }
192  elsif (/^-k$/)
193  {
194    $keep = "yes";
195  }
196  elsif (/^-g$/)
197  {
198    $generate = "yes";
199  }
200  elsif(/^-v$/)
201  {
202    $verbosity = shift;
203  }
204  else
205  {
206    print (STDERR "Unrecognised option: $_\n") && &Usage && die;
207  }
208}
209
210# if no command line arguments are left, use regress.lst
211if ($#ARGV == -1)
212{
213  $ARGV[0] = "regress.lst";
214}
215
216# make sure $singular exists and is executable
217if ( ! (-e $singular))
218{
219  print (STDERR "Can not find $singular \n") && &Usage && die;
220}
221if (! (-x $singular))
222{
223  print (STDERR "Can not execute $singular \n") && Usage && die;
224}
225
226# now do the work
227foreach (@ARGV)
228{
229  # get root and extension
230  ($extension = $_) =~ s/.*\.([^\.]*)$/$1/;
231  ($root = $_) =~ s/(.*)\.[^\.]*$/$1/;
232
233  if ($extension eq "tst")
234  {
235    $exit_code = & tst_check($root) || $exit_code;
236  }
237  elsif ($extension eq "lst")
238  {
239    if (! open(LST_FILE, "<$_"))
240    {
241      print (STDERR "Can not open $_ for reading\n");
242      $exit_code = 1;
243      next;
244    }
245    while (<LST_FILE>)
246    {
247      if (/^;/)
248      {
249        print unless ($verbosity == 0);
250        next;
251      }
252      next if (/^\s*$/);
253      chop if (/\n$/);
254      ($extension = $_) =~ s/.*\.([^\.]*)$/$1/;
255      ($root = $_) =~ s/(.*)\.[^\.]*$/$1/;
256      $exit_code = & tst_check($root) || $exit_code;
257    }
258    close (LST_FILE);
259  }
260  else
261  {
262    print (STDERR "Unknown extension of $_: Need extension lst or tst\n");
263    $exit_code = 1;
264  }
265}
266
267# Und Tschuess
268exit $exit_code;
269
270
Note: See TracBrowser for help on using the repository browser.