[1a300b9] | 1 | #!/usr/bin/perl -CS |
---|
[b35b93] | 2 | |
---|
| 3 | ################################################################# |
---|
[341696] | 4 | # $Id$ |
---|
[b21d63] | 5 | # FILE: regress.cmd |
---|
[b35b93] | 6 | # PURPOSE: Script which runs regress test of Singular |
---|
| 7 | # CREATED: 2/16/98 |
---|
| 8 | # AUTHOR: obachman@mathematik.uni-kl.de |
---|
| 9 | |
---|
[1a300b9] | 10 | use Env; |
---|
| 11 | |
---|
[b35b93] | 12 | ################################################################# |
---|
[b21d63] | 13 | # |
---|
[b35b93] | 14 | # usage |
---|
[b21d63] | 15 | # |
---|
[b35b93] | 16 | sub Usage |
---|
| 17 | { |
---|
| 18 | print <<_EOM_ |
---|
| 19 | Usage: |
---|
| 20 | regress.cmd -- regress test of Singular |
---|
[e960fdf] | 21 | [-s <Singular>] -- use <Singular> as executable to test |
---|
| 22 | [-h] -- print out help and exit |
---|
| 23 | [-k] -- keep all intermediate files |
---|
[6d01ca] | 24 | [-v num] -- set verbosity to num (used range 0..4, default: 2) |
---|
[e960fdf] | 25 | [-g] -- generate result (*.res.gz.uu) files, only |
---|
| 26 | [-r [crit%[val]]] -- report if status differences [of crit] > val (in %) |
---|
[31f293] | 27 | [-c regexp] -- when comparing results, version must match this regexp |
---|
[e960fdf] | 28 | [-e [crit%[val]]] -- throw error if status difference [of crit] > val (in %) |
---|
[31f293] | 29 | [-a [crit]] -- add status results [of crit] to result file |
---|
| 30 | [-m] -- add status result for current version to result file |
---|
[0b20296] | 31 | [-t] -- compute and call system("mtrack", 1) at the end, no diffs |
---|
[a7bb142] | 32 | [-A num] -- set timeout [in sec.] for executed Singular |
---|
[1a300b9] | 33 | [-C name] -- be TeamCity friendly, use "name" as a test-suite name |
---|
[0b20296] | 34 | [-tt max] -- compute and call system("mtrack", max) at the end |
---|
[6d01ca] | 35 | [-T] -- simply compute and determine timmings, no diffs |
---|
[e960fdf] | 36 | [file.lst] -- read tst files from file.lst |
---|
[b21d63] | 37 | [file.tst] -- test Singular script file.tst |
---|
[b35b93] | 38 | _EOM_ |
---|
| 39 | } |
---|
| 40 | |
---|
| 41 | ################################################################# |
---|
[b21d63] | 42 | # |
---|
[b35b93] | 43 | # used programs |
---|
| 44 | # |
---|
[55f154] | 45 | $sh="/bin/sh"; |
---|
[b35b93] | 46 | $diff = "diff"; |
---|
| 47 | $gunzip = "gunzip"; |
---|
| 48 | $gzip = "gzip"; |
---|
| 49 | $rm = "rm"; |
---|
[d5e119] | 50 | $mv = "mv"; |
---|
[b35b93] | 51 | $cp = "cp"; |
---|
[d5e119] | 52 | $tr = "tr"; |
---|
| 53 | $sed = "sed"; |
---|
| 54 | $cat = "cat"; |
---|
| 55 | $tee = "tee"; |
---|
[e960fdf] | 56 | $grep = "grep"; |
---|
[55f154] | 57 | |
---|
| 58 | sub mysystem |
---|
| 59 | { |
---|
| 60 | local($call) = $_[0]; |
---|
| 61 | local($exit_status); |
---|
| 62 | |
---|
| 63 | $call =~ s/"/\\"/g; |
---|
| 64 | $call = "$sh -c \"$call\""; |
---|
[6d01ca] | 65 | print "$call\n" if ($verbosity > 2); |
---|
[55f154] | 66 | return (system $call); |
---|
| 67 | } |
---|
| 68 | |
---|
[e960fdf] | 69 | sub mysystem_catch |
---|
| 70 | { |
---|
| 71 | local($call) = $_[0]; |
---|
| 72 | local($output) = ""; |
---|
| 73 | |
---|
| 74 | $call = "$call > catch_$$"; |
---|
[93e538] | 75 | mysystem($call); |
---|
[b21d63] | 76 | |
---|
[e960fdf] | 77 | open(CATCH_FILE, "<catch_$$"); |
---|
| 78 | while (<CATCH_FILE>) |
---|
| 79 | { |
---|
| 80 | $output = $output.$_; |
---|
| 81 | } |
---|
| 82 | close(CATCH_FILE); |
---|
[93e538] | 83 | mysystem("$rm -f catch_$$"); |
---|
[e960fdf] | 84 | return $output; |
---|
| 85 | } |
---|
| 86 | |
---|
[93e538] | 87 | $WINNT = 1 if (mysystem("uname -a | $grep CYGWIN > /dev/null 2>&1") == 0); |
---|
[e519027] | 88 | $uuencode = "uuencode"; |
---|
| 89 | $uudecode = "uudecode"; |
---|
[d5e119] | 90 | |
---|
[ff4a69] | 91 | # |
---|
| 92 | # flush stdout and stderr after every write |
---|
| 93 | # |
---|
| 94 | select(STDERR); |
---|
| 95 | $| = 1; |
---|
| 96 | select(STDOUT); |
---|
| 97 | $| = 1; |
---|
| 98 | |
---|
[b35b93] | 99 | ################################################################# |
---|
[b21d63] | 100 | # |
---|
[55f154] | 101 | # the default settings |
---|
| 102 | # |
---|
[56ae4f] | 103 | $singularOptions = "--ticks-per-sec=100 -teqsr12345678 --no-rc"; |
---|
[21a762] | 104 | # for testing under Windows, remove "e" option above and compile |
---|
| 105 | # res files on Linux, then copy to Windows and compare. Otherwise |
---|
| 106 | # you have problems with diff on Win. Just uncomment the next line: |
---|
[56ae4f] | 107 | # $singularOptions = "--ticks-per-sec=100 -tqsr12345678 --no-rc"; |
---|
[21a762] | 108 | |
---|
[55f154] | 109 | $keep = "no"; |
---|
[6d01ca] | 110 | $verbosity = 2; |
---|
[55f154] | 111 | $generate = "no"; |
---|
| 112 | $exit_code = 0; |
---|
| 113 | chop($curr_dir=`pwd`); |
---|
| 114 | # singular -- use the one in curr directory or the one found above |
---|
| 115 | $ext=".exe" if ($WINNT); |
---|
| 116 | $singular = "$curr_dir/Singular$ext"; |
---|
| 117 | if ( (! (-e $singular)) || (! (-x $singular))) |
---|
[b35b93] | 118 | { |
---|
[55f154] | 119 | $singular = $curr_dir."/../Singular$ext"; |
---|
[b35b93] | 120 | } |
---|
[a7bb142] | 121 | # timeout for Singular execution (in seconds!) |
---|
| 122 | $timeout = 0; |
---|
[55f154] | 123 | # sed scripts which are applied to res files before they are diff'ed |
---|
[1cb879] | 124 | $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' -e 's/\\[[0-9]*:[0-9]*\\]//g'"; |
---|
[e960fdf] | 125 | # default value (in %) above which differences are reported on -r |
---|
[e2114af] | 126 | $report_val = 5; |
---|
[e960fdf] | 127 | # default value (in %) above which differences cause an error on -e |
---|
[e2114af] | 128 | $error_val = 5; |
---|
[374b14] | 129 | # default value in 1/100 seconds, above which time differences are reported |
---|
[a23d8e] | 130 | $mintime_val = 100; |
---|
[93e538] | 131 | $hostname = mysystem_catch("hostname"); |
---|
[e960fdf] | 132 | chop $hostname; |
---|
[55f154] | 133 | |
---|
[1a300b9] | 134 | # flag indicating whether to produce TeamCity output ("" - no): |
---|
| 135 | $teamcity = ""; |
---|
| 136 | # current argument: test file name? |
---|
| 137 | $test_file = ""; |
---|
| 138 | |
---|
[93e538] | 139 | # all previous test_file's: |
---|
| 140 | %test_files = (); |
---|
[1a300b9] | 141 | |
---|
| 142 | |
---|
| 143 | ################################################################# |
---|
| 144 | # |
---|
| 145 | # teamcity helpers: |
---|
| 146 | # |
---|
| 147 | sub myGetTCprop |
---|
| 148 | { |
---|
| 149 | local($prop) = $_[0]; |
---|
[93e538] | 150 | return( mysystem_catch("cat \"\$TEAMCITY_BUILD_PROPERTIES_FILE\"|grep \"$prop=\"|sed \"s/$prop=//\"") ); |
---|
[1a300b9] | 151 | } |
---|
| 152 | |
---|
| 153 | sub tc_filter |
---|
| 154 | { |
---|
| 155 | local($t) = $_[0]; |
---|
| 156 | |
---|
| 157 | $t =~ s/\|/|\|/g; |
---|
| 158 | |
---|
| 159 | $t =~ s/\n/|n/g; |
---|
| 160 | $t =~ s/\r/|r/g; |
---|
| 161 | |
---|
| 162 | $t =~ s/\u0085/|x/g; |
---|
| 163 | $t =~ s/\u2028/|l/g; |
---|
| 164 | $t =~ s/\u2029/|p/g; |
---|
| 165 | |
---|
| 166 | ## \x{263A} |
---|
| 167 | |
---|
| 168 | $t =~ s/\'/|\'/g; |
---|
| 169 | $t =~ s/\[/|\[/g; |
---|
| 170 | $t =~ s/\]/|\]/g; |
---|
| 171 | return ($t); |
---|
| 172 | } |
---|
| 173 | sub putTCmsg |
---|
| 174 | { |
---|
| 175 | if( length($teamcity) > 0 ) |
---|
| 176 | { |
---|
| 177 | local($message) = $_[0]; |
---|
| 178 | local($text) = $_[1]; |
---|
| 179 | |
---|
| 180 | print( "\n##teamcity[$message $text]\n" ); |
---|
| 181 | } |
---|
| 182 | } |
---|
| 183 | sub putTCmsgV |
---|
| 184 | { |
---|
| 185 | local($message) = $_[0]; |
---|
| 186 | local($unquotedValue) = tc_filter($_[1]); |
---|
| 187 | |
---|
| 188 | putTCmsg( $message, "\'$unquotedValue\'"); |
---|
| 189 | } |
---|
| 190 | sub putTCmsgNV |
---|
| 191 | { |
---|
| 192 | local($m) = $_[0]; |
---|
| 193 | local($p) = $_[1]; |
---|
| 194 | local($v) = tc_filter($_[2]); |
---|
| 195 | putTCmsg( $m, "$p=\'$v\'" ); |
---|
| 196 | } |
---|
| 197 | sub putTCmsgNV2 |
---|
| 198 | { |
---|
| 199 | local($m) = $_[0]; |
---|
| 200 | local($p) = $_[1]; |
---|
| 201 | local($v) = tc_filter($_[2]); |
---|
| 202 | local($pp) = $_[3]; |
---|
| 203 | local($vv) = tc_filter($_[4]); |
---|
| 204 | putTCmsg( $m, "$p='$v' $pp='$vv'" ); |
---|
| 205 | } |
---|
| 206 | |
---|
| 207 | ################################################################# |
---|
| 208 | # |
---|
| 209 | # teamcity routines: |
---|
| 210 | # |
---|
| 211 | sub blockOpened |
---|
| 212 | { |
---|
| 213 | local($v) = $_[0]; |
---|
| 214 | putTCmsgNV( "blockOpened", "name", $v); |
---|
| 215 | } |
---|
| 216 | sub blockClosed |
---|
| 217 | { |
---|
| 218 | local($v) = $_[0]; |
---|
| 219 | putTCmsgNV( "blockClosed", "name", $v); |
---|
| 220 | } |
---|
| 221 | sub tcError |
---|
| 222 | { |
---|
[ebb444] | 223 | local($text) = tc_filter($_[0]); |
---|
| 224 | local($details) = tc_filter($_[1]); |
---|
| 225 | local($status) = tc_filter($_[2]); |
---|
[1a300b9] | 226 | # The status attribute may take following values: |
---|
| 227 | # NORMAL, WARNING, FAILURE, ERROR. |
---|
| 228 | # The default value is NORMAL. |
---|
| 229 | # The errorDetails attribute is used only if status is ERROR, in other cases it is ignored. |
---|
| 230 | # This message fails the build in case its status is ERROR and "Fail build if an error message is logged by build runner" checkbox is checked on build configuration general settings page. |
---|
| 231 | |
---|
| 232 | ##teamcity[message text='<message text>' errorDetails='<error details>' status='<status value>'] |
---|
[ebb444] | 233 | putTCmsg( "message", "text=\'$text\' errorDetails=\'$details\' status=\'$status\'"); |
---|
| 234 | } |
---|
| 235 | |
---|
| 236 | sub tcFailure |
---|
| 237 | { |
---|
| 238 | local($text) = tc_filter($_[0]); |
---|
| 239 | local($details) = tc_filter($_[1]); |
---|
| 240 | tcError( $text, $details, "FAILURE" ); |
---|
| 241 | } |
---|
| 242 | |
---|
| 243 | sub tcLog |
---|
| 244 | { |
---|
| 245 | local($text) = $_[0]; |
---|
| 246 | putTCmsgNV2( "message", "text", $text, "status", "NORMAL"); |
---|
| 247 | } |
---|
| 248 | sub tcWarn |
---|
| 249 | { |
---|
| 250 | local($text) = $_[0]; |
---|
| 251 | putTCmsgNV2( "message", "text", $text, "status", "WARNING"); |
---|
[1a300b9] | 252 | } |
---|
| 253 | |
---|
| 254 | sub testSuiteStarted |
---|
| 255 | { |
---|
| 256 | local($v) = $_[0]; |
---|
| 257 | putTCmsgNV( "testSuiteStarted", "name", $v); |
---|
| 258 | } |
---|
| 259 | sub testSuiteFinished |
---|
| 260 | { |
---|
| 261 | local($v) = $_[0]; |
---|
| 262 | putTCmsgNV( "testSuiteFinished", "name", $v); |
---|
| 263 | } |
---|
[ebb444] | 264 | |
---|
| 265 | $failed = 0; |
---|
| 266 | |
---|
[1a300b9] | 267 | sub testStarted |
---|
| 268 | { |
---|
| 269 | local($v) = $_[0]; |
---|
| 270 | putTCmsgNV2( "testStarted", "name", $v, "captureStandardOutput", "true"); |
---|
[ebb444] | 271 | $failed = 0; |
---|
[1a300b9] | 272 | } |
---|
| 273 | sub testFinished |
---|
| 274 | { |
---|
| 275 | local($v) = $_[0]; |
---|
| 276 | local($d) = $_[1]; |
---|
[ebb444] | 277 | putTCmsgNV2( "testFinished", "name", $v, "duration", $d); |
---|
| 278 | $failed = 0; |
---|
[1a300b9] | 279 | } |
---|
[ebb444] | 280 | |
---|
[1a300b9] | 281 | sub testFailed |
---|
| 282 | { |
---|
| 283 | local($n) = $_[0]; |
---|
| 284 | local($m) = $_[1]; |
---|
[ebb444] | 285 | |
---|
| 286 | if( !$failed ) |
---|
| 287 | { |
---|
| 288 | putTCmsgNV2( "testFailed", "name", $n, "message", $m); |
---|
| 289 | $failed = 1; |
---|
| 290 | } else |
---|
| 291 | { |
---|
| 292 | tcFailure("Test: $n => $m", ""); |
---|
| 293 | } |
---|
[1a300b9] | 294 | } |
---|
| 295 | sub testFailed2 |
---|
| 296 | { |
---|
| 297 | local($n) = tc_filter($_[0]); |
---|
| 298 | local($m) = tc_filter($_[1]); |
---|
| 299 | local($t) = tc_filter($_[2]); |
---|
[ebb444] | 300 | if( !$failed ) |
---|
| 301 | { |
---|
| 302 | putTCmsg( "testFailed", "name=\'$n\' message=\'$m\' details=\'$t\'"); |
---|
| 303 | $failed = 1; |
---|
| 304 | } else |
---|
| 305 | { |
---|
| 306 | tcFailure("Test: $n => $m", $t); |
---|
| 307 | } |
---|
| 308 | |
---|
[1a300b9] | 309 | } |
---|
| 310 | sub testFailedCMP |
---|
| 311 | { |
---|
[ebb444] | 312 | local($name) = tc_filter($_[0]); |
---|
| 313 | local($msg) = tc_filter($_[1]); |
---|
| 314 | local($details) = tc_filter($_[2]); |
---|
| 315 | local($expected) = tc_filter($_[3]); |
---|
| 316 | local($actual) = tc_filter($_[4]); |
---|
| 317 | if( !$failed ) |
---|
| 318 | { |
---|
| 319 | putTCmsg( "testFailed", "type=\'comparisonFailure\' name=\'$name\' message=\'$msg\' details=\'$details\' expected=\'$expected\' actual=\'$actual\'"); |
---|
| 320 | $failed = 1; |
---|
| 321 | } else |
---|
| 322 | { |
---|
| 323 | tcFailure("Test: $name => $msg", "$detail\nExpected: $expected\nActual: $actual"); |
---|
| 324 | } |
---|
| 325 | |
---|
[1a300b9] | 326 | } |
---|
| 327 | |
---|
[ebb444] | 328 | ##teamcity[testFailed type='comparisonFailure' name='test_file' message='failure_message' details='message and stack trace' expected='expected value' actual='actual value'] |
---|
[1a300b9] | 329 | sub testIgnored |
---|
| 330 | { |
---|
| 331 | local($n) = $_[0]; |
---|
| 332 | local($m) = $_[1]; |
---|
| 333 | putTCmsgNV2( "testIgnored", "name", $n, "message", $m); |
---|
| 334 | } |
---|
| 335 | |
---|
| 336 | |
---|
| 337 | |
---|
[55f154] | 338 | ################################################################# |
---|
[b21d63] | 339 | # |
---|
[55f154] | 340 | # auxiallary routines |
---|
[b21d63] | 341 | # |
---|
[e960fdf] | 342 | |
---|
[31f293] | 343 | sub GetSingularVersionDate |
---|
| 344 | { |
---|
[93e538] | 345 | mysystem("$singular -t -v --execute=\"exit;\"> SingularVersionDate"); |
---|
[31f293] | 346 | open(FD, "<SingularVersionDate"); |
---|
| 347 | while (<FD>) |
---|
| 348 | { |
---|
| 349 | $singular_uname = (/for\s+([^\s]*)\s+/ ? $1 : "uname"); |
---|
| 350 | $singular_version = (/version\s+([^\s]*)\s+/ ? $1 : "0-0-0"); |
---|
| 351 | $singular_date = (/\((.*)\)/ ? $1 : "1970010100"); |
---|
| 352 | $this_time = time; |
---|
| 353 | last; |
---|
| 354 | } |
---|
| 355 | close(FD); |
---|
[93e538] | 356 | mysystem("if [ -e /proc/cpuinfo ]; then cat /proc/cpuinfo >> SingularVersionDate; fi "); |
---|
| 357 | mysystem("sysctl -a >> SingularVersionDate"); |
---|
| 358 | mysystem("uname -a >> SingularVersionDate"); |
---|
| 359 | mysystem("if [ -e /proc/meminfo ]; then cat /proc/meminfo >> SingularVersionDate; fi "); |
---|
| 360 | mysystem("free -h >> SingularVersionDate"); |
---|
[31f293] | 361 | } |
---|
| 362 | |
---|
[d5e119] | 363 | sub Set_withMP |
---|
| 364 | { |
---|
| 365 | if (! $withMP) |
---|
| 366 | { |
---|
| 367 | $withMP = "no"; |
---|
[4c79e7] | 368 | open(MP_TEST, ">MPTest"); |
---|
| 369 | print(MP_TEST "system(\"with\", \"MP\"); \$"); |
---|
| 370 | close(MP_TEST); |
---|
[93e538] | 371 | mysystem("$singular -qt MPTest > withMPtest"); |
---|
[d5e119] | 372 | if (open(MP_TEST, "<withMPtest")) |
---|
| 373 | { |
---|
| 374 | $_ = <MP_TEST>; |
---|
| 375 | $withMP = "yes" if (/^1/); |
---|
| 376 | close(MP_TEST); |
---|
| 377 | } |
---|
[93e538] | 378 | mysystem("$rm -f withMPtest MPTest"); |
---|
[d5e119] | 379 | } |
---|
| 380 | } |
---|
[b21d63] | 381 | |
---|
| 382 | |
---|
[d5e119] | 383 | sub MPok |
---|
| 384 | { |
---|
| 385 | local($root) = $_[0]; |
---|
[b21d63] | 386 | |
---|
[d5e119] | 387 | if (! open(TST_FILE, "<$root.tst")) |
---|
| 388 | { |
---|
| 389 | print (STDERR "Can not open $root.tst for reading\n"); |
---|
| 390 | return (0); |
---|
| 391 | } |
---|
| 392 | while (<TST_FILE>) |
---|
| 393 | { |
---|
| 394 | if (/\"MP.+:.*\"/) |
---|
| 395 | { |
---|
| 396 | &Set_withMP; |
---|
| 397 | return (0) if ($withMP eq "no"); |
---|
| 398 | } |
---|
| 399 | } |
---|
| 400 | return (1); |
---|
| 401 | } |
---|
[e960fdf] | 402 | |
---|
[d5e119] | 403 | sub Diff |
---|
| 404 | { |
---|
| 405 | local($root) = $_[0]; |
---|
| 406 | local($exit_status); |
---|
[b21d63] | 407 | |
---|
| 408 | # prepare the result files: |
---|
[93e538] | 409 | mysystem("$cat \"$root.res\" | $tr -d '\\013' | $sed $sed_scripts > \"$root.res.cleaned\""); |
---|
| 410 | mysystem("$cat \"$root.new.res\" | $tr -d '\\013' | $sed $sed_scripts > \"$root.new.res.cleaned\""); |
---|
[d5e119] | 411 | |
---|
| 412 | # doo the diff call |
---|
[93e538] | 413 | $exit_status = mysystem("$diff -w -b \"$root.res.cleaned\" \"$root.new.res.cleaned\" > \"$root.diff\" 2>&1"); |
---|
[b21d63] | 414 | |
---|
[ebb444] | 415 | |
---|
[d5e119] | 416 | # clean up time |
---|
[93e538] | 417 | mysystem("$rm -f \"$root.res.cleaned\" \"$root.new.res.cleaned\""); |
---|
[b21d63] | 418 | |
---|
[d5e119] | 419 | # there seems to be a bug here somewhere: even if diff reported |
---|
| 420 | # differenceses and exited with status != 0, then system still |
---|
| 421 | # returns exit status 0. Hence we manually need to find out whether |
---|
[b21d63] | 422 | # or not differences were reported: |
---|
[d5e119] | 423 | # iff diff-file exists and has non-zero size |
---|
| 424 | $exit_status = $exit_status || (-e "$root.diff" && -s "$root.diff"); |
---|
| 425 | |
---|
[ebb444] | 426 | if( $exit_status && (length($teamcity) > 0) ) |
---|
| 427 | { |
---|
| 428 | local($details) = mysystem_catch("$cat \"$root.diff\""); |
---|
| 429 | local($expected) = mysystem_catch("$cat \"$root.res\""); |
---|
| 430 | local($actual) = mysystem_catch("$cat \"$root.new.res\""); |
---|
| 431 | testFailedCMP($test_file, "Differences in res files", $details, $expected, $actual ) |
---|
| 432 | } |
---|
| 433 | |
---|
[d5e119] | 434 | return($exit_status); |
---|
| 435 | } |
---|
[b21d63] | 436 | |
---|
[e960fdf] | 437 | sub tst_status_check |
---|
[b35b93] | 438 | { |
---|
| 439 | local($root) = $_[0]; |
---|
[e960fdf] | 440 | local($line,$new_line,$prefix,$crit,$res,$new_res); |
---|
| 441 | local($res_diff,$res_diff_pc,$res_diff_line); |
---|
[31f293] | 442 | my($exit_status, $reported) = (0, 0); |
---|
[e960fdf] | 443 | local($error_cause) = ""; |
---|
[b21d63] | 444 | |
---|
| 445 | open(RES_FILE, "<$root.stat") || |
---|
[e2114af] | 446 | return (1, "Can not open $root.stat \n"); |
---|
| 447 | open(NEW_RES_FILE, "<$root.new.stat") || |
---|
| 448 | return (1, "Can not open $root.new.stat \n"); |
---|
[a23d8e] | 449 | open(STATUS_DIFF_FILE, ">$root.stat.sdiff") || |
---|
| 450 | return (1, "Can not open $root.stat.sdiff \n"); |
---|
[e2114af] | 451 | |
---|
[31f293] | 452 | while (1) |
---|
[e960fdf] | 453 | { |
---|
[31f293] | 454 | while ($new_line = <NEW_RES_FILE>) |
---|
[e960fdf] | 455 | { |
---|
[31f293] | 456 | last if $new_line =~ /(\d+) >> (\w+) ::.*$hostname:(\d+)/ && $checks{$2}; |
---|
| 457 | } |
---|
| 458 | last unless $new_line =~ /(\d+) >> (\w+) ::.*$hostname:(\d+)/; |
---|
| 459 | $prefix = $1; |
---|
| 460 | $crit = $2; |
---|
| 461 | $new_res = $3; |
---|
| 462 | next unless $new_res > $mintime_val; |
---|
| 463 | |
---|
| 464 | while ($line = <RES_FILE>) |
---|
| 465 | { |
---|
| 466 | last if $line =~ /$prefix >> $crit ::.*?$hostname:(\d+)/; |
---|
| 467 | } |
---|
| 468 | last unless $line =~ /$prefix >> $crit ::.*?$hostname:(\d+)/; |
---|
| 469 | my $res_version; |
---|
| 470 | $res = 0; |
---|
[b21d63] | 471 | |
---|
[31f293] | 472 | # search for smallest |
---|
| 473 | while ($line =~ /([^\s]*)$hostname:(\d+)/g) |
---|
| 474 | { |
---|
| 475 | my $this_res = $2; |
---|
| 476 | my $this_res_version = $1; |
---|
| 477 | if ((!$res || $this_res <= $res) && (!$status_check_regexp || $this_res_version =~ /$status_check_regexp/)) |
---|
| 478 | { |
---|
| 479 | $res = $this_res; |
---|
| 480 | $res_version = $this_res_version; |
---|
[e960fdf] | 481 | } |
---|
| 482 | } |
---|
[31f293] | 483 | next unless $res; |
---|
| 484 | $res_diff = $new_res - $res; |
---|
| 485 | $res_diff_pc = int((($new_res / $res) - 1)*100); |
---|
| 486 | $res_diff_line = |
---|
| 487 | "$prefix >> $crit :: new:$new_res old:$res_version$res diff:$res_diff %:$res_diff_pc\n"; |
---|
| 488 | print STATUS_DIFF_FILE $res_diff_line; |
---|
| 489 | |
---|
| 490 | if ((defined($error{$crit}) && $error{$crit}<abs($res_diff_pc)) |
---|
| 491 | || |
---|
| 492 | (defined($report{$crit}) && $report{$crit}<abs($res_diff_pc))) |
---|
| 493 | { |
---|
| 494 | print "$prefix >> $crit :: new:$new_res old:$res diff:$res_diff %:$res_diff_pc\n" |
---|
| 495 | if ($verbosity > 0); |
---|
| 496 | } |
---|
| 497 | |
---|
| 498 | if ($exit_status == 0) |
---|
| 499 | { |
---|
| 500 | $exit_status = (defined($error{$crit}) |
---|
| 501 | && $error{$crit} < abs($res_diff_pc)); |
---|
| 502 | $error_cause = "Status error for $crit at $prefix\n" |
---|
| 503 | if ($exit_status); |
---|
| 504 | } |
---|
[e960fdf] | 505 | } |
---|
| 506 | close(RES_FILE); |
---|
| 507 | close(NEW_RES_FILE); |
---|
| 508 | close(STATUS_DIFF_FILE); |
---|
| 509 | return ($exit_status, $error_cause); |
---|
| 510 | } |
---|
[b35b93] | 511 | |
---|
[e960fdf] | 512 | sub tst_status_merge |
---|
| 513 | { |
---|
| 514 | local($root) = $_[0]; |
---|
| 515 | local($line, $new_line, $crit, $res); |
---|
[b21d63] | 516 | |
---|
[31f293] | 517 | GetSingularVersionDate() |
---|
| 518 | unless $singular_version; |
---|
| 519 | |
---|
| 520 | if (! -e "$root.stat") |
---|
| 521 | { |
---|
| 522 | open(RES_FILE, ">$root.stat") || |
---|
| 523 | return (1, "Can not open $root.stat \n"); |
---|
| 524 | open(NEW_RES_FILE, "<$root.new.stat") || |
---|
| 525 | return (1, "Can not open $root.new.stat \n"); |
---|
| 526 | |
---|
| 527 | while (<NEW_RES_FILE>) |
---|
| 528 | { |
---|
| 529 | if (/(\d+) >> (\w+) :: /) |
---|
| 530 | { |
---|
[1a300b9] | 531 | s/$hostname:(\d+)/$this_time:$singular_date:$singular_version:$singular_uname:$hostname:$1/g; |
---|
| 532 | print RES_FILE $_; |
---|
[31f293] | 533 | } |
---|
| 534 | } |
---|
| 535 | close(RES_FILE); |
---|
| 536 | close(NEW_RES_FILE); |
---|
| 537 | return; |
---|
| 538 | } |
---|
| 539 | |
---|
[b21d63] | 540 | open(RES_FILE, "<$root.stat") || |
---|
[e2114af] | 541 | return (1, "Can not open $root.stat \n"); |
---|
| 542 | open(NEW_RES_FILE, "<$root.new.stat") || |
---|
| 543 | return (1, "Can not open $root.new.stat \n"); |
---|
| 544 | open(TEMP_FILE, ">$root.tmp.stat") || |
---|
| 545 | return (1, "Can not open $root.tmp.stat \n"); |
---|
[b21d63] | 546 | |
---|
[31f293] | 547 | while (1) |
---|
[e960fdf] | 548 | { |
---|
[31f293] | 549 | while (($new_line = <NEW_RES_FILE>) && $new_line !~ /(\d+) >> (\w+) ::/){} |
---|
| 550 | last unless $new_line =~ /(\d+) >> (\w+) ::.*$hostname:(\d+)/; |
---|
| 551 | my $prefix = $1; |
---|
| 552 | my $crit = $2; |
---|
| 553 | my $new_res = "$this_time:$singular_date:$singular_version:$singular_uname:$hostname:$3"; |
---|
| 554 | while (($line = <RES_FILE>) && $line !~ /$prefix >> $crit ::/){} |
---|
| 555 | unless ($line) |
---|
[e960fdf] | 556 | { |
---|
[31f293] | 557 | close(RES_FILE); |
---|
| 558 | close(NEW_RES_FILE); |
---|
| 559 | close(TEMP_FILE); |
---|
[93e538] | 560 | mysystem("$rm \"$root.tmp.stat\""); |
---|
[31f293] | 561 | return (1, "Can not find '$prefix >> $crit' in $root.stat\n"); |
---|
| 562 | } |
---|
| 563 | if ($merge_version) |
---|
| 564 | { |
---|
| 565 | $line =~ s/[^ ]*:$singular_version:$singular_uname:$hostname:\d+//g; |
---|
| 566 | chop $line; |
---|
| 567 | $line .= " $new_res\n"; |
---|
[e960fdf] | 568 | } |
---|
| 569 | else |
---|
| 570 | { |
---|
[31f293] | 571 | chop $line; |
---|
| 572 | $line .= " $new_res\n"; |
---|
[e960fdf] | 573 | } |
---|
[31f293] | 574 | print TEMP_FILE $line; |
---|
[e960fdf] | 575 | } |
---|
[31f293] | 576 | |
---|
[e960fdf] | 577 | close(RES_FILE); |
---|
| 578 | close(NEW_RES_FILE); |
---|
| 579 | close(TEMP_FILE); |
---|
[93e538] | 580 | mysystem("$mv -f \"$root.tmp.stat\" \"$root.stat\""); |
---|
| 581 | mysystem("$rm -f \"$root.new.stat\" \"$root.stat.sdiff\"") unless $keep eq "yes"; |
---|
[31f293] | 582 | return ; |
---|
[e960fdf] | 583 | } |
---|
| 584 | |
---|
| 585 | sub tst_check |
---|
| 586 | { |
---|
| 587 | local($root) = $_[0]; |
---|
| 588 | local($system_call, $exit_status, $ignore_pattern, $error_cause); |
---|
[b21d63] | 589 | |
---|
[93e538] | 590 | if( exists($test_files{$test_file}) && (length($teamcity) > 0) ) |
---|
| 591 | { |
---|
| 592 | tcWarn("The test '$test_file' have been alreeady tests (with result: $test_files{$test_file})... skipping!"); |
---|
| 593 | return ($test_files{$test_file}) |
---|
| 594 | } |
---|
[6d01ca] | 595 | |
---|
[93e538] | 596 | $total_checks++; |
---|
| 597 | |
---|
[b35b93] | 598 | # check for existence/readablity of tst and res file |
---|
| 599 | if (! (-r "$root.tst")) |
---|
| 600 | { |
---|
[dfe914] | 601 | print "--- $root " unless ($verbosity == 0); |
---|
[b35b93] | 602 | print (STDERR "Can not read $root.tst\n"); |
---|
[1a300b9] | 603 | testIgnored($test_file, "Can not read $root.tst"); |
---|
[93e538] | 604 | $test_files{$test_file} = 1; |
---|
[b35b93] | 605 | return (1); |
---|
| 606 | } |
---|
[b21d63] | 607 | |
---|
[d5e119] | 608 | # ignore MP stuff, if this singular does not have MP |
---|
[93e538] | 609 | if (! MPok($root)) |
---|
[d5e119] | 610 | { |
---|
[dfe914] | 611 | print "--- $root " unless ($verbosity == 0); |
---|
[d5e119] | 612 | print "Warning: $root not tested: needs MP\n"; |
---|
[1a300b9] | 613 | testIgnored($test_file, "Warning: $root not tested: needs MP"); |
---|
[93e538] | 614 | $test_files{$test_file} = 0; |
---|
[d5e119] | 615 | return (0); |
---|
| 616 | } |
---|
[b21d63] | 617 | |
---|
[d5e119] | 618 | # generate $root.res |
---|
[6d01ca] | 619 | if ($generate ne "yes" && ! defined($mtrack) && !defined($timings_only)) |
---|
[b35b93] | 620 | { |
---|
[49d361] | 621 | if ((-r "$root.res.gz.uu") && ! ( -z "$root.res.gz.uu")) |
---|
[b35b93] | 622 | { |
---|
[93e538] | 623 | $exit_status = mysystem("$uudecode \"$root.res.gz.uu\" > /dev/null 2>&1; $gunzip -f \"$root.res.gz\""); |
---|
[b35b93] | 624 | if ($exit_status) |
---|
| 625 | { |
---|
[dfe914] | 626 | print "--- $root " unless ($verbosity == 0); |
---|
[b21d63] | 627 | print (STDERR "Can not decode $root.res.gz.uu\n"); |
---|
[1a300b9] | 628 | testIgnored($test_file, "Can not decode $root.res.gz.uu"); |
---|
[93e538] | 629 | $test_files{$test_file} = $exit_status; |
---|
[b21d63] | 630 | return ($exit_status); |
---|
[b35b93] | 631 | } |
---|
| 632 | } |
---|
[49d361] | 633 | elsif (! (-r "$root.res") || ( -z "$root.res")) |
---|
| 634 | { |
---|
[dfe914] | 635 | print "--- $root " unless ($verbosity == 0); |
---|
[49d361] | 636 | print (STDERR "Can not read $root.res[.gz.uu]\n"); |
---|
[1a300b9] | 637 | testIgnored($test_file, "Can not read $root.res[.gz.uu]"); |
---|
[93e538] | 638 | $test_files{$test_file} = 1; |
---|
[49d361] | 639 | return (1); |
---|
| 640 | } |
---|
[b35b93] | 641 | } |
---|
[e960fdf] | 642 | |
---|
[1a300b9] | 643 | testStarted($test_file); |
---|
[dfe914] | 644 | print "--- $root " unless ($verbosity == 0); |
---|
[1a300b9] | 645 | |
---|
[f5128b8] | 646 | my $resfile = "\"$root.new.res\""; |
---|
| 647 | $resfile = "\"$root.mtrack.res\"" if (defined($mtrack)); |
---|
[31f293] | 648 | my $statfile = "$root.new.stat"; |
---|
[93e538] | 649 | mysystem("$rm -f \"$statfile\""); |
---|
[1a300b9] | 650 | |
---|
[0b20296] | 651 | if (defined($mtrack)) |
---|
[b35b93] | 652 | { |
---|
[f5128b8] | 653 | $system_call = "$cat \"$root.tst\" | sed -e 's/\\\\\$/LIB \"general.lib\"; killall(); killall(\"proc\");kill killall;system(\"mtrack\", \"$root.mtrack.unused\", $mtrack); \\\$/' | $singular $singularOptions "; |
---|
[6d01ca] | 654 | $system_call .= ($verbosity > 3 ? " | $tee " : " > "); |
---|
[f5128b8] | 655 | $system_call .= "\"$root.mtrack.res\""; |
---|
[6d01ca] | 656 | $system_call .= " 2>&1 " if ($verbosity <= 3); |
---|
[b35b93] | 657 | } |
---|
| 658 | else |
---|
| 659 | { |
---|
[31f293] | 660 | |
---|
[9a50a2] | 661 | # prepare Singular run |
---|
[6d01ca] | 662 | if ($verbosity > 3 && !$WINNT) |
---|
[9a50a2] | 663 | { |
---|
[f5128b8] | 664 | $system_call = "$cat \"$root.tst\" | $singular --execute 'string tst_status_file=\"$statfile\";' $singularOptions | $tee $resfile"; |
---|
[9a50a2] | 665 | } |
---|
| 666 | else |
---|
| 667 | { |
---|
[f5128b8] | 668 | $system_call = "$cat \"$root.tst\" | $singular --execute 'string tst_status_file=\"$statfile\";' $singularOptions > $resfile 2>&1"; |
---|
[9a50a2] | 669 | } |
---|
[b35b93] | 670 | } |
---|
| 671 | # Go Singular, Go! |
---|
[6d01ca] | 672 | |
---|
| 673 | my ($user_t,$system_t,$cuser_t,$csystem_t) = times; |
---|
[93e538] | 674 | $exit_status = mysystem($system_call); |
---|
[6d01ca] | 675 | my ($user_t,$system_t,$cuser_t2,$csystem_t2) = times; |
---|
| 676 | $cuser_t = $cuser_t2 - $cuser_t; |
---|
| 677 | $csystem_t = $csystem_t2 - $csystem_t; |
---|
[ebb444] | 678 | |
---|
| 679 | tcLog("Test: $test_file, user time: $cuser_t, system time: $csystem_t" ); |
---|
| 680 | |
---|
[e960fdf] | 681 | if ($exit_status != 0) |
---|
[b35b93] | 682 | { |
---|
[ebb444] | 683 | $error_cause = "Singular call exited with status ($exit_status) != 0"; |
---|
| 684 | |
---|
| 685 | if( length($teamcity) > 0 ) |
---|
| 686 | { |
---|
| 687 | ### TODO: add a way to detect timeout!!! |
---|
| 688 | if( $exit_status == 142 ) # perl sig alarm exit code? NOPE :((( |
---|
| 689 | { |
---|
| 690 | local($details) = mysystem_catch("$cat \"$resfile\""); |
---|
| 691 | testFailed2($test_file, "Exit on timeout ($timeout sec)!", $details); |
---|
| 692 | } |
---|
| 693 | } |
---|
[b35b93] | 694 | } |
---|
[e960fdf] | 695 | else |
---|
[b35b93] | 696 | { |
---|
[e960fdf] | 697 | # check for Segment fault in res file |
---|
[93e538] | 698 | $exit_status = ! (mysystem("$grep \"Segment fault\" $resfile > /dev/null 2>&1")); |
---|
[b21d63] | 699 | |
---|
[e960fdf] | 700 | if ($exit_status) |
---|
| 701 | { |
---|
| 702 | $error_cause = "Segment fault"; |
---|
[ebb444] | 703 | local($details) = mysystem_catch("$cat \"$resfile\""); |
---|
| 704 | testFailed2($test_file, $error_cause, $details); |
---|
[e960fdf] | 705 | } |
---|
[6d01ca] | 706 | elsif (! defined($mtrack) && !defined($timings_only)) |
---|
[e960fdf] | 707 | { |
---|
[93e538] | 708 | mysystem("$rm -f \"$root.diff\""); |
---|
[e960fdf] | 709 | if ($generate eq "yes") |
---|
| 710 | { |
---|
[93e538] | 711 | mysystem("$cp $resfile \"$root.res\""); |
---|
[e960fdf] | 712 | } |
---|
[b21d63] | 713 | else |
---|
[e960fdf] | 714 | { |
---|
[b21d63] | 715 | # call Diff |
---|
[93e538] | 716 | $exit_status = Diff($root); |
---|
[b21d63] | 717 | if ($exit_status) |
---|
| 718 | { |
---|
[2ae411d] | 719 | unless ($verbosity == 0) |
---|
| 720 | { |
---|
| 721 | print "\n"; |
---|
[f5128b8] | 722 | mysystem("$cat \"$root.diff\""); |
---|
[2ae411d] | 723 | } |
---|
[b21d63] | 724 | $error_cause = "Differences in res files"; |
---|
| 725 | } |
---|
| 726 | else |
---|
| 727 | { |
---|
[93e538] | 728 | mysystem("$rm -f \"$root.diff\""); |
---|
[b21d63] | 729 | } |
---|
[e960fdf] | 730 | } |
---|
| 731 | } |
---|
[b35b93] | 732 | } |
---|
[e960fdf] | 733 | |
---|
[f5128b8] | 734 | |
---|
| 735 | |
---|
| 736 | mysystem("mv tst_status.out \"$statfile\"") |
---|
[31f293] | 737 | if (! -e $statfile && -e "tst_status.out"); |
---|
| 738 | |
---|
[0b20296] | 739 | if (%checks && ! $exit_status && $generate ne "yes" && ! defined($mtrack)) |
---|
[e2114af] | 740 | { |
---|
[31f293] | 741 | if (-e "$statfile") |
---|
[a21c9c] | 742 | { |
---|
| 743 | # do status checks |
---|
[93e538] | 744 | ($exit_status, $error_cause) = tst_status_check($root); |
---|
[a21c9c] | 745 | } |
---|
[f50a14] | 746 | else |
---|
| 747 | { |
---|
[31f293] | 748 | print "Warning: no file $statfile\n"; |
---|
[93e538] | 749 | tcWarn("Warning: no file $statfile"); |
---|
[f50a14] | 750 | } |
---|
[e2114af] | 751 | } |
---|
[b21d63] | 752 | |
---|
| 753 | |
---|
[b35b93] | 754 | # complain even if verbosity == 0 |
---|
[e960fdf] | 755 | if ($exit_status) |
---|
[b35b93] | 756 | { |
---|
[2ae411d] | 757 | if (! -e "$root.diff") |
---|
| 758 | { |
---|
| 759 | open (DIFF_FILE, ">$root.diff"); |
---|
| 760 | print DIFF_FILE "!!! $root : $error_cause\n"; |
---|
| 761 | print "\n"; |
---|
| 762 | } |
---|
| 763 | print STDERR "!!! $root : $error_cause\n"; |
---|
[ebb444] | 764 | |
---|
| 765 | if( length($teamcity) > 0 ) |
---|
| 766 | { |
---|
| 767 | local($details) = mysystem_catch("$cat \"$resfile\""); |
---|
| 768 | testFailed2($test_file, $error_cause, $details); |
---|
| 769 | } |
---|
[b35b93] | 770 | } |
---|
[e960fdf] | 771 | else |
---|
[d5e119] | 772 | { |
---|
[0b20296] | 773 | unless (defined($mtrack)) |
---|
[b35b93] | 774 | { |
---|
[9a50a2] | 775 | #clean up |
---|
| 776 | if ($generate eq "yes") |
---|
[e2114af] | 777 | { |
---|
[f5128b8] | 778 | mysystem("$rm -f \"$root.stat\"") unless %merge; |
---|
[31f293] | 779 | ($exit_status, $error_cause) = tst_status_merge($root); |
---|
[9a50a2] | 780 | if (! $WINNT) |
---|
| 781 | { |
---|
[93e538] | 782 | mysystem("$gzip -cf \"$root.res\" | $uuencode \"$root.res.gz\" > \"$root.res.gz.uu\""); |
---|
[9a50a2] | 783 | } |
---|
| 784 | else |
---|
| 785 | { |
---|
| 786 | # uuencode is broken under windows |
---|
| 787 | print "Warning: Can not generate $root.res.gz.uu under Windows\n"; |
---|
| 788 | } |
---|
[e2114af] | 789 | } |
---|
[9a50a2] | 790 | elsif (%merge) |
---|
[e2114af] | 791 | { |
---|
[93e538] | 792 | ($exit_status, $error_cause) = tst_status_merge($root); |
---|
[9a50a2] | 793 | |
---|
[31f293] | 794 | print (STDERR "Warning: Merge Problems: $error_cause\n") |
---|
| 795 | if ($verbosity > 0 && $exit_status); |
---|
[e2114af] | 796 | } |
---|
| 797 | } |
---|
[e960fdf] | 798 | if ($keep ne "yes") |
---|
[d5e119] | 799 | { |
---|
[93e538] | 800 | mysystem("$rm -f tst_status.out $resfile \"$root.res\" \"$root.diff\" \"$root.new.stat\""); |
---|
[b21d63] | 801 | } |
---|
[b35b93] | 802 | } |
---|
[d5e119] | 803 | # und tschuess |
---|
[2ae411d] | 804 | unless ($verbosity == 0 || $exit_status) |
---|
[6d01ca] | 805 | { |
---|
| 806 | if ($verbosity > 1 || $timings_only) |
---|
| 807 | { |
---|
| 808 | my $used_time = $cuser_t + $csystem_t; |
---|
| 809 | $total_used_time += $used_time; |
---|
| 810 | $lst_used_time += $used_time; |
---|
| 811 | print " " x (23 - length($root)); |
---|
| 812 | printf("%.2f", $used_time); |
---|
| 813 | } |
---|
| 814 | print " \n"; |
---|
| 815 | } |
---|
[2ae411d] | 816 | $total_checks_pass++ unless $exit_status; |
---|
[f5128b8] | 817 | |
---|
[93e538] | 818 | mysystem("mv gmon.out \"gmon.$root.out\"") if (-e "gmon.out"); |
---|
[ebb444] | 819 | |
---|
[1a300b9] | 820 | testFinished($test_file, $cuser_t + $csystem_t); |
---|
| 821 | |
---|
[93e538] | 822 | $test_files{$test_file} = $exit_status; |
---|
[b35b93] | 823 | return ($exit_status); |
---|
| 824 | } |
---|
| 825 | |
---|
| 826 | |
---|
| 827 | ################################################################# |
---|
[b21d63] | 828 | # |
---|
[b35b93] | 829 | # Main program |
---|
[b21d63] | 830 | # |
---|
[b35b93] | 831 | |
---|
| 832 | # process switches |
---|
| 833 | while ($ARGV[0] =~ /^-/) |
---|
| 834 | { |
---|
| 835 | $_ = shift; |
---|
| 836 | if (/^-s$/) |
---|
| 837 | { |
---|
| 838 | $singular = shift; |
---|
| 839 | } |
---|
| 840 | elsif (/^-h$/) |
---|
| 841 | { |
---|
| 842 | &Usage && exit (0); |
---|
| 843 | } |
---|
| 844 | elsif (/^-k$/) |
---|
| 845 | { |
---|
| 846 | $keep = "yes"; |
---|
| 847 | } |
---|
| 848 | elsif (/^-g$/) |
---|
| 849 | { |
---|
| 850 | $generate = "yes"; |
---|
| 851 | } |
---|
| 852 | elsif(/^-v$/) |
---|
| 853 | { |
---|
| 854 | $verbosity = shift; |
---|
| 855 | } |
---|
[0b20296] | 856 | elsif (/^-tt/) |
---|
| 857 | { |
---|
| 858 | $mtrack = shift; |
---|
| 859 | } |
---|
[a7bb142] | 860 | elsif (/^-A/) |
---|
| 861 | { |
---|
| 862 | $timeout = shift; |
---|
| 863 | } |
---|
[1a300b9] | 864 | elsif (/^-C$/) |
---|
| 865 | { |
---|
| 866 | $teamcity = shift; |
---|
| 867 | } |
---|
[9a50a2] | 868 | elsif(/^-t$/) |
---|
| 869 | { |
---|
| 870 | $mtrack = 1; |
---|
| 871 | } |
---|
[6d01ca] | 872 | elsif (/^-T/) |
---|
| 873 | { |
---|
| 874 | $timings_only = 1; |
---|
| 875 | } |
---|
[e960fdf] | 876 | elsif(/^-r$/) |
---|
| 877 | { |
---|
| 878 | $crit = "all"; |
---|
| 879 | $val = $report_val; |
---|
| 880 | if ($ARGV[0] =~ /.*%.*/) |
---|
| 881 | { |
---|
| 882 | ($crit, $val) = split(/%/, shift); |
---|
| 883 | } |
---|
[b21d63] | 884 | elsif ($ARGV[0] && |
---|
| 885 | $ARGV[0] !~ /^-/ && $ARGV[0] !~ /.*\.tst/ && $ARGV[0] !~ /.*\.lst/) |
---|
[e960fdf] | 886 | { |
---|
| 887 | $crit = shift; |
---|
| 888 | } |
---|
| 889 | if ($crit eq "all") |
---|
| 890 | { |
---|
| 891 | $report{"tst_memory_0"} = $val; |
---|
| 892 | $report{"tst_memory_1"} = $val; |
---|
| 893 | $report{"tst_memory_2"} = $val; |
---|
| 894 | $report{"tst_timer"} = $val; |
---|
| 895 | $report{"tst_timer_1"} = $val; |
---|
[b21d63] | 896 | $checks{"tst_memory_0"} = 1; |
---|
[e960fdf] | 897 | $checks{"tst_memory_1"} = 1; |
---|
[b21d63] | 898 | $checks{"tst_memory_2"} = 1; |
---|
| 899 | $checks{"tst_timer"} = 1; |
---|
| 900 | $checks{"tst_timer_1"} = 1; |
---|
[e960fdf] | 901 | } |
---|
| 902 | else |
---|
| 903 | { |
---|
| 904 | $report{$crit} = $val; |
---|
| 905 | $checks{$crit} = 1; |
---|
| 906 | } |
---|
| 907 | } |
---|
| 908 | elsif(/^-e$/) |
---|
| 909 | { |
---|
| 910 | $crit = "all"; |
---|
| 911 | $val = $error_val; |
---|
| 912 | if ($ARGV[0] =~ /.*%.*/) |
---|
| 913 | { |
---|
| 914 | ($crit, $val) = split(/%/, shift); |
---|
| 915 | } |
---|
[b21d63] | 916 | elsif ($ARGV[0] && |
---|
| 917 | $ARGV[0] !~ /^-/ && $ARGV[0] !~ /.*\.tst/ && $ARGV[0] !~ /.*\.lst/) |
---|
[e960fdf] | 918 | { |
---|
| 919 | $crit = shift; |
---|
| 920 | } |
---|
| 921 | if ($crit eq "all") |
---|
| 922 | { |
---|
| 923 | $error{"tst_memory_0"} = $val; |
---|
| 924 | $error{"tst_memory_1"} = $val; |
---|
| 925 | $error{"tst_memory_2"} = $val; |
---|
| 926 | $error{"tst_timer"} = $val; |
---|
| 927 | $error{"tst_timer_1"} = $val; |
---|
[b21d63] | 928 | $checks{"tst_memory_0"} = 1; |
---|
[e960fdf] | 929 | $checks{"tst_memory_1"} = 1; |
---|
[b21d63] | 930 | $checks{"tst_memory_2"} = 1; |
---|
| 931 | $checks{"tst_timer"} = 1; |
---|
| 932 | $checks{"tst_timer_1"} = 1; |
---|
[e960fdf] | 933 | } |
---|
| 934 | else |
---|
| 935 | { |
---|
| 936 | $error{$crit} = $val; |
---|
| 937 | $checks{$crit} = 1; |
---|
| 938 | } |
---|
| 939 | } |
---|
[31f293] | 940 | elsif(/^-a/ || /^-m/) |
---|
[e960fdf] | 941 | { |
---|
[31f293] | 942 | $merge_version = 1 if /^-m/; |
---|
[b21d63] | 943 | if ($ARGV[0] && |
---|
| 944 | $ARGV[0] !~ /^-/ && $ARGV[0] !~ /.*\.tst/ && $ARGV[0] !~ /.*\.lst/) |
---|
[e960fdf] | 945 | { |
---|
| 946 | $crit = shift; |
---|
| 947 | $merge{$crit} = 1; |
---|
| 948 | } |
---|
| 949 | else |
---|
| 950 | { |
---|
[b21d63] | 951 | $merge{"tst_memory_0"} = 1; |
---|
[e960fdf] | 952 | $merge{"tst_memory_1"} = 1; |
---|
[b21d63] | 953 | $merge{"tst_memory_2"} = 1; |
---|
| 954 | $merge{"tst_timer"} = 1; |
---|
| 955 | $merge{"tst_timer_1"} = 1; |
---|
[e960fdf] | 956 | } |
---|
| 957 | } |
---|
[31f293] | 958 | elsif (/^-c/) |
---|
| 959 | { |
---|
| 960 | $status_check_regexp = shift; |
---|
| 961 | } |
---|
[b21d63] | 962 | else |
---|
[b35b93] | 963 | { |
---|
| 964 | print (STDERR "Unrecognised option: $_\n") && &Usage && die; |
---|
| 965 | } |
---|
| 966 | } |
---|
| 967 | |
---|
| 968 | # if no command line arguments are left, use regress.lst |
---|
| 969 | if ($#ARGV == -1) |
---|
| 970 | { |
---|
| 971 | $ARGV[0] = "regress.lst"; |
---|
| 972 | } |
---|
| 973 | |
---|
| 974 | # make sure $singular exists and is executable |
---|
[55f154] | 975 | $singular = "$curr_dir/$singular" unless ($singular =~ /^\/.*/); |
---|
[d5e119] | 976 | |
---|
[4c79e7] | 977 | if ( ! (-e $singular)) |
---|
| 978 | { |
---|
| 979 | $singular = "$singular$ext" if ($WINNT && $singular !~ /.*$ext$/); |
---|
| 980 | } |
---|
| 981 | |
---|
[b35b93] | 982 | if ( ! (-e $singular)) |
---|
| 983 | { |
---|
| 984 | print (STDERR "Can not find $singular \n") && &Usage && die; |
---|
| 985 | } |
---|
[4c79e7] | 986 | |
---|
| 987 | if (! (-x $singular) && (! WINNT)) |
---|
[b35b93] | 988 | { |
---|
[d5e119] | 989 | print (STDERR "Can not execute $singular \n") && &Usage && die; |
---|
| 990 | } |
---|
| 991 | if (-d $singular) |
---|
| 992 | { |
---|
| 993 | print (STDERR "$singular is a directory\n") && &Usage && die; |
---|
[b35b93] | 994 | } |
---|
| 995 | |
---|
[867952] | 996 | sub ViewFile |
---|
| 997 | { |
---|
| 998 | local($f) = $_[0]; |
---|
| 999 | |
---|
| 1000 | local($ff) = myGetTCprop($f); |
---|
| 1001 | local($b) = "$f: " . $ff; |
---|
| 1002 | |
---|
| 1003 | blockOpened ($b); |
---|
[93e538] | 1004 | mysystem("cat " . $ff); |
---|
[867952] | 1005 | blockClosed ($b); |
---|
| 1006 | } |
---|
| 1007 | |
---|
[663baa] | 1008 | |
---|
[e1b6326] | 1009 | # if( length($teamcity) > 0 ) |
---|
| 1010 | # { |
---|
| 1011 | # # tcLog("|Hi|\r I\'m [Alex]|\nHow are You?|"); |
---|
| 1012 | # |
---|
| 1013 | # blockOpened ("init"); |
---|
| 1014 | # |
---|
| 1015 | # # print ("TEAMCITY_BUILD_PROPERTIES_FILE: $ENV{TEAMCITY_BUILD_PROPERTIES_FILE}" ); |
---|
| 1016 | # |
---|
| 1017 | # tcLog("TEAMCITY_BUILD_PROPERTIES_FILE: $ENV{TEAMCITY_BUILD_PROPERTIES_FILE}"); |
---|
| 1018 | # |
---|
| 1019 | # if ( length("$ENV{TEAMCITY_BUILD_PROPERTIES_FILE}") > 0 ) |
---|
| 1020 | # { |
---|
| 1021 | # print( "teamcity.tests.runRiskGroupTestsFirst: " . myGetTCprop("teamcity.tests.runRiskGroupTestsFirst") . "\n" ); |
---|
| 1022 | # |
---|
| 1023 | # ViewFile("teamcity.tests.recentlyFailedTests.file"); |
---|
| 1024 | # ViewFile("teamcity.build.changedFiles.file"); |
---|
| 1025 | # ViewFile("teamcity.build.properties.file"); |
---|
| 1026 | # ViewFile("teamcity.configuration.properties.file"); |
---|
| 1027 | # ViewFile("teamcity.runner.properties.file"); |
---|
| 1028 | # } |
---|
| 1029 | # |
---|
| 1030 | # blockClosed ("init"); |
---|
| 1031 | # } |
---|
[1a300b9] | 1032 | |
---|
[a7bb142] | 1033 | if ($timeout > 0) |
---|
| 1034 | { |
---|
[ebb444] | 1035 | $singular = "PERL_SIGNALS=unsafe perl -e 'alarm($timeout);exec(\@ARGV);' $singular"; |
---|
[1a300b9] | 1036 | tcLog ("Set exec timeout to $timeout sec.\n"); |
---|
[a7bb142] | 1037 | # die; |
---|
| 1038 | } |
---|
[1a300b9] | 1039 | |
---|
| 1040 | testSuiteStarted($teamcity); |
---|
| 1041 | |
---|
[663baa] | 1042 | # now do the work |
---|
| 1043 | foreach (@ARGV) |
---|
[b35b93] | 1044 | { |
---|
[52f5a58] | 1045 | if( /^([^:]*): *(.*)$/ ) |
---|
| 1046 | { |
---|
| 1047 | $_=$2; |
---|
| 1048 | } |
---|
| 1049 | |
---|
| 1050 | if ( /^\s*([^ ].*)$/ ) |
---|
| 1051 | { |
---|
| 1052 | $_ = $1; |
---|
| 1053 | } |
---|
| 1054 | |
---|
| 1055 | if ( /^\.\/(.*)$/ ) |
---|
| 1056 | { |
---|
| 1057 | $_ = $1; |
---|
| 1058 | } |
---|
| 1059 | |
---|
[1a300b9] | 1060 | $test_file = $_; |
---|
[b35b93] | 1061 | |
---|
[1a300b9] | 1062 | tcLog("test_file: $test_file"); |
---|
[52f5a58] | 1063 | |
---|
[b21d63] | 1064 | if ( /^(.*)\.([^\.\/]*)$/ ) |
---|
[d5e119] | 1065 | { |
---|
| 1066 | $_ = $1; |
---|
| 1067 | $extension = $2; |
---|
[52f5a58] | 1068 | } else |
---|
| 1069 | { |
---|
| 1070 | print ("Wrong input: [$_] has no extension!"); |
---|
| 1071 | tcWarn("Wrong input: [$_] has no extension!"); |
---|
| 1072 | next; |
---|
[d5e119] | 1073 | } |
---|
[52f5a58] | 1074 | |
---|
| 1075 | |
---|
| 1076 | |
---|
| 1077 | |
---|
[d5e119] | 1078 | |
---|
[b21d63] | 1079 | if ( /^(.*)\/([^\/]*)$/ ) |
---|
[d5e119] | 1080 | { |
---|
| 1081 | $path = $1; |
---|
| 1082 | $base = $2; |
---|
| 1083 | chdir($path); |
---|
[6d01ca] | 1084 | print "cd $path\n" if ($verbosity > 2); |
---|
[b21d63] | 1085 | } |
---|
| 1086 | else |
---|
[d5e119] | 1087 | { |
---|
| 1088 | $path = ""; |
---|
| 1089 | $base = $_; |
---|
| 1090 | } |
---|
[1a300b9] | 1091 | |
---|
| 1092 | tcLog("path: $path, base: $base, extension: $extension"); |
---|
| 1093 | |
---|
[d5e119] | 1094 | $file = "$base.$extension"; |
---|
| 1095 | chop ($tst_curr_dir = `pwd`); |
---|
[b21d63] | 1096 | |
---|
[b35b93] | 1097 | if ($extension eq "tst") |
---|
| 1098 | { |
---|
[93e538] | 1099 | $exit_code = tst_check($base) || $exit_code; |
---|
[b35b93] | 1100 | } |
---|
| 1101 | elsif ($extension eq "lst") |
---|
| 1102 | { |
---|
[d5e119] | 1103 | if (! open(LST_FILE, "<$file")) |
---|
[b35b93] | 1104 | { |
---|
[d5e119] | 1105 | print (STDERR "Can not open $path/$file for reading\n"); |
---|
[b35b93] | 1106 | $exit_code = 1; |
---|
[1a300b9] | 1107 | testIgnored($test_file, "Can not open $path/$file for reading"); |
---|
[b35b93] | 1108 | next; |
---|
| 1109 | } |
---|
[1a300b9] | 1110 | |
---|
| 1111 | local ($b) = $test_file; |
---|
| 1112 | blockOpened ($b); |
---|
| 1113 | |
---|
[6d01ca] | 1114 | $lst_used_time = 0; |
---|
| 1115 | $lst_checks = 0; |
---|
| 1116 | $lst_checks_pass = 0; |
---|
[b35b93] | 1117 | while (<LST_FILE>) |
---|
| 1118 | { |
---|
[d5e119] | 1119 | if (/^;/) # ignore lines starting with ; |
---|
[b35b93] | 1120 | { |
---|
[663baa] | 1121 | print unless ($verbosity == 0); |
---|
[b21d63] | 1122 | next; |
---|
[b35b93] | 1123 | } |
---|
[52f5a58] | 1124 | if( /^([^:]*): *(.*)$/ ) |
---|
| 1125 | { |
---|
| 1126 | $_=$2; |
---|
| 1127 | } |
---|
| 1128 | |
---|
| 1129 | if ( /^\s*([^\s].*)$/ ) |
---|
| 1130 | { |
---|
| 1131 | $_ = $1; |
---|
| 1132 | } |
---|
| 1133 | |
---|
| 1134 | if ( /^\.\/(.*)$/ ) |
---|
| 1135 | { |
---|
| 1136 | $_ = $1; |
---|
| 1137 | } |
---|
| 1138 | |
---|
[d5e119] | 1139 | next if (/^\s*$/); #ignore whitespaced lines |
---|
[663baa] | 1140 | chop if (/\n$/); #chop of \n |
---|
[1a300b9] | 1141 | |
---|
| 1142 | tcLog("path: $path, test_file: $_, file: $file"); |
---|
| 1143 | |
---|
| 1144 | if (length($path) > 0) |
---|
| 1145 | { |
---|
| 1146 | $test_file = "$path/$_"; |
---|
| 1147 | } |
---|
| 1148 | else |
---|
| 1149 | { |
---|
| 1150 | $test_file = $_; |
---|
| 1151 | } |
---|
[52f5a58] | 1152 | |
---|
| 1153 | $test_file =~ s/^[ ]*\.\///; |
---|
[1a300b9] | 1154 | |
---|
| 1155 | |
---|
| 1156 | $_ = $1 if (/^(.*)\.([^\.\/]*)$/ ); # chop of extension (.tst!!!?) |
---|
[b21d63] | 1157 | if ( /^(.*)\/([^\/]*)$/ ) |
---|
[d5e119] | 1158 | { |
---|
[b21d63] | 1159 | $tst_path = $1; |
---|
| 1160 | $tst_base = $2; |
---|
[d5e119] | 1161 | chdir($tst_path); |
---|
[6d01ca] | 1162 | print "cd $tst_path\n" if ($verbosity > 2); |
---|
[b21d63] | 1163 | } |
---|
| 1164 | else |
---|
[d5e119] | 1165 | { |
---|
[b21d63] | 1166 | $tst_path = ""; |
---|
| 1167 | $tst_base = $_; |
---|
[d5e119] | 1168 | } |
---|
[9a50a2] | 1169 | $tst_base =~ s/^\s*//; |
---|
| 1170 | $tst_base =~ s/(.*?)\s+.*/$1/; |
---|
[6d01ca] | 1171 | $lst_checks++; |
---|
[1a300b9] | 1172 | |
---|
| 1173 | tcLog("tst_path: $tst_path, tst_base: $tst_base"); |
---|
| 1174 | |
---|
[93e538] | 1175 | my $this_exit_code = tst_check($tst_base); |
---|
[1a300b9] | 1176 | |
---|
[6d01ca] | 1177 | $lst_checks_pass++ unless $this_exit_code; |
---|
| 1178 | $exit_code = $this_exit_code || $exit_code; |
---|
[d5e119] | 1179 | |
---|
| 1180 | if ($tst_path ne "") |
---|
| 1181 | { |
---|
[b21d63] | 1182 | chdir($tst_curr_dir); |
---|
[6d01ca] | 1183 | print "cd $tst_curr_dir\n" if ($verbosity > 2); |
---|
[d5e119] | 1184 | } |
---|
[b35b93] | 1185 | } |
---|
| 1186 | close (LST_FILE); |
---|
[93e538] | 1187 | |
---|
| 1188 | printf("$base Summary: Checks:$lst_checks Failed:%d Time:%.2f\n", $lst_checks - $lst_checks_pass, $lst_used_time) |
---|
[1a300b9] | 1189 | unless ($verbosity < 2); |
---|
[93e538] | 1190 | |
---|
| 1191 | tcLog( sprintf("list '$base' Summary: Checks:$lst_checks Failed:%d Time:%.2f", $lst_checks - $lst_checks_pass, $lst_used_time) ); |
---|
[1a300b9] | 1192 | blockClosed ($b); |
---|
[b35b93] | 1193 | } |
---|
| 1194 | else |
---|
| 1195 | { |
---|
| 1196 | print (STDERR "Unknown extension of $_: Need extension lst or tst\n"); |
---|
| 1197 | $exit_code = 1; |
---|
| 1198 | } |
---|
[d5e119] | 1199 | if ($path ne "") |
---|
| 1200 | { |
---|
[663baa] | 1201 | chdir($curr_dir); |
---|
[6d01ca] | 1202 | print "cd $curr_dir\n" if ($verbosity > 2); |
---|
[d5e119] | 1203 | } |
---|
[b35b93] | 1204 | } |
---|
| 1205 | |
---|
[6d01ca] | 1206 | unless ($verbosity < 2 || $lst_checks == $total_checks) |
---|
| 1207 | { |
---|
| 1208 | printf("Summary: Checks:$total_checks Failed:%d Time:%.2f\n", $total_checks - $total_checks_pass, $total_used_time); |
---|
| 1209 | } |
---|
| 1210 | |
---|
[93e538] | 1211 | tcLog( sprintf("Global Summary: Checks:$total_checks Failed:%d Time:%.2f", $total_checks - $total_checks_pass, $total_used_time)) ; |
---|
| 1212 | |
---|
[1a300b9] | 1213 | if( length($teamcity) > 0 ) |
---|
| 1214 | { |
---|
| 1215 | testSuiteFinished($teamcity); |
---|
[617c427] | 1216 | |
---|
[867952] | 1217 | # blockOpened ("init"); |
---|
[617c427] | 1218 | |
---|
| 1219 | # print ("TEAMCITY_BUILD_PROPERTIES_FILE: $ENV{TEAMCITY_BUILD_PROPERTIES_FILE}" ); |
---|
| 1220 | |
---|
[867952] | 1221 | # blockClosed ("init"); |
---|
[617c427] | 1222 | |
---|
| 1223 | |
---|
| 1224 | |
---|
[1a300b9] | 1225 | } |
---|
| 1226 | |
---|
| 1227 | |
---|
[b35b93] | 1228 | # Und Tschuess |
---|
| 1229 | exit $exit_code; |
---|
| 1230 | |
---|
| 1231 | |
---|