[b35b93] | 1 | #!/usr/bin/perl |
---|
| 2 | |
---|
| 3 | ################################################################# |
---|
[887c937] | 4 | # $Id: regress.cmd,v 1.8 1998-05-03 13:11:26 obachman Exp $ |
---|
[b35b93] | 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 | # |
---|
| 14 | sub Usage |
---|
| 15 | { |
---|
| 16 | print <<_EOM_ |
---|
| 17 | Usage: |
---|
| 18 | regress.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 |
---|
[863a27] | 22 | [-k] -- keep result (*.res) files, do not zip original res file |
---|
[b35b93] | 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"; |
---|
[a19ac9] | 35 | $ignore = "-I '^\/\/.*used time:' -I '^\/\/.*ignore:' -I '? error occurred in'"; |
---|
[b35b93] | 36 | $keep = "no"; |
---|
| 37 | $verbosity = 1; |
---|
| 38 | $generate = "no"; |
---|
| 39 | $exit_code = 0; |
---|
| 40 | $singular = "./Singular"; |
---|
| 41 | if ( (! (-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"; |
---|
[863a27] | 56 | $uuencode = "uuencode"; |
---|
| 57 | $uudecode = "uudecode"; |
---|
[b35b93] | 58 | |
---|
| 59 | ################################################################# |
---|
| 60 | # |
---|
| 61 | # tst_check($root) |
---|
| 62 | # |
---|
| 63 | sub mysystem |
---|
| 64 | { |
---|
| 65 | local($call) = $_[0]; |
---|
| 66 | local($exit_status); |
---|
| 67 | |
---|
| 68 | print "$call\n" if ($verbosity > 1); |
---|
| 69 | return (system $call); |
---|
| 70 | } |
---|
| 71 | |
---|
| 72 | sub 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 | } |
---|
[49d361] | 84 | if ($generate ne "yes") |
---|
[b35b93] | 85 | { |
---|
[49d361] | 86 | if ((-r "$root.res.gz.uu") && ! ( -z "$root.res.gz.uu")) |
---|
[b35b93] | 87 | { |
---|
[49d361] | 88 | $exit_status |
---|
| 89 | = $exit_status || &mysystem("$uudecode -o $root.res.gz $root.res.gz.uu; $gunzip -f $root.res.gz"); |
---|
[b35b93] | 90 | if ($exit_status) |
---|
| 91 | { |
---|
[49d361] | 92 | print (STDERR "Can not decode $root.res.gz.uu\n"); |
---|
[b35b93] | 93 | return ($exit_status); |
---|
| 94 | } |
---|
| 95 | } |
---|
[49d361] | 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 | } |
---|
[b35b93] | 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"); |
---|
[863a27] | 149 | if (-r "$root.res.gz.uu") |
---|
[b35b93] | 150 | { |
---|
| 151 | & mysystem("$rm -rf $root.res"); |
---|
| 152 | } |
---|
| 153 | else |
---|
| 154 | { |
---|
[e36ae54] | 155 | & mysystem("$gzip -f $root.res; $uuencode $root.res.gz $root.res.gz > $root.res.gz.uu; $rm -rf $root.res.gz"); |
---|
[b35b93] | 156 | } |
---|
| 157 | } |
---|
| 158 | elsif ($generate eq "yes") |
---|
| 159 | { |
---|
[887c937] | 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"); |
---|
[b35b93] | 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 |
---|
| 177 | while ($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 |
---|
| 211 | if ($#ARGV == -1) |
---|
| 212 | { |
---|
| 213 | $ARGV[0] = "regress.lst"; |
---|
| 214 | } |
---|
| 215 | |
---|
| 216 | # make sure $singular exists and is executable |
---|
| 217 | if ( ! (-e $singular)) |
---|
| 218 | { |
---|
| 219 | print (STDERR "Can not find $singular \n") && &Usage && die; |
---|
| 220 | } |
---|
| 221 | if (! (-x $singular)) |
---|
| 222 | { |
---|
| 223 | print (STDERR "Can not execute $singular \n") && Usage && die; |
---|
| 224 | } |
---|
| 225 | |
---|
| 226 | # now do the work |
---|
| 227 | foreach (@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 |
---|
| 268 | exit $exit_code; |
---|
| 269 | |
---|
| 270 | |
---|