source: git/Tst/regress.cmd @ 4c5b46

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