[b35b93] | 1 | #!/usr/bin/perl |
---|
| 2 | |
---|
| 3 | ################################################################# |
---|
[e35965] | 4 | # $Id: regress.cmd,v 1.5 1998-04-23 12:44:46 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 | } |
---|
[e35965] | 84 | if ((! (-r "$root.res")) || (-z "$root.res")) |
---|
[b35b93] | 85 | { |
---|
[e35965] | 86 | if ((! (-r "$root.res.gz")) || (-z "$root.res.gz")) |
---|
[b35b93] | 87 | { |
---|
[e35965] | 88 | if ((! (-r "$root.res.gz.uu")) || (-z "$root.res.gz.uu")) |
---|
[b35b93] | 89 | { |
---|
[863a27] | 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 | } |
---|
[b35b93] | 105 | } |
---|
| 106 | } |
---|
| 107 | else |
---|
| 108 | { |
---|
| 109 | $exit_status = $exit_status || & mysystem("$gunzip -f -c $root.res.gz > $root.res"); |
---|
| 110 | if ($exit_status) |
---|
| 111 | { |
---|
[863a27] | 112 | print (STDERR "Can not `$gunzip -f -c $root.res.gz > $root.res'\n" ); |
---|
[b35b93] | 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"); |
---|
[863a27] | 163 | if (-r "$root.res.gz.uu") |
---|
[b35b93] | 164 | { |
---|
| 165 | & mysystem("$rm -rf $root.res"); |
---|
| 166 | } |
---|
| 167 | else |
---|
| 168 | { |
---|
[d6fc3c] | 169 | & mysystem("$gzip -f $root.res; $uuencode $root.res.gz $root.res.gz > $root.res.gz.uu"); |
---|
[b35b93] | 170 | } |
---|
| 171 | } |
---|
| 172 | elsif ($generate eq "yes") |
---|
| 173 | { |
---|
[d6fc3c] | 174 | & mysystem("$gzip -f $root.res; $uuencode $root.res.gz $root.res.gz > $root.res.gz.uu"); |
---|
[b35b93] | 175 | if ($keep eq "yes") |
---|
| 176 | { |
---|
| 177 | & mysystem("mv $root.new.res $root.res"); |
---|
| 178 | } |
---|
| 179 | else |
---|
| 180 | { |
---|
[d6fc3c] | 181 | & mysystem("$rm -rf $root.new.res $root.res.gz"); |
---|
[b35b93] | 182 | } |
---|
| 183 | } |
---|
| 184 | |
---|
| 185 | return ($exit_status); |
---|
| 186 | } |
---|
| 187 | |
---|
| 188 | |
---|
| 189 | ################################################################# |
---|
| 190 | # |
---|
| 191 | # Main program |
---|
| 192 | # |
---|
| 193 | |
---|
| 194 | # process switches |
---|
| 195 | while ($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 |
---|
| 229 | if ($#ARGV == -1) |
---|
| 230 | { |
---|
| 231 | $ARGV[0] = "regress.lst"; |
---|
| 232 | } |
---|
| 233 | |
---|
| 234 | # make sure $singular exists and is executable |
---|
| 235 | if ( ! (-e $singular)) |
---|
| 236 | { |
---|
| 237 | print (STDERR "Can not find $singular \n") && &Usage && die; |
---|
| 238 | } |
---|
| 239 | if (! (-x $singular)) |
---|
| 240 | { |
---|
| 241 | print (STDERR "Can not execute $singular \n") && Usage && die; |
---|
| 242 | } |
---|
| 243 | |
---|
| 244 | # now do the work |
---|
| 245 | foreach (@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 |
---|
| 286 | exit $exit_code; |
---|
| 287 | |
---|
| 288 | |
---|