source: git/Tst/regress.cmd @ 098f98f

fieker-DuValspielwiese
Last change on this file since 098f98f was 341696, checked in by Hans Schönemann <hannes@…>, 15 years ago
Adding Id property to all files git-svn-id: file:///usr/local/Singular/svn/trunk@12231 2c84dea3-7e68-4137-9b89-c4e89433aadc
  • Property mode set to 100755
File size: 19.8 KB
Line 
1#!/usr/bin/perl
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
10#################################################################
11#
12# usage
13#
14sub Usage
15{
16  print <<_EOM_
17Usage:
18regress.cmd    -- regress test of Singular
19  [-s <Singular>]   -- use <Singular> as executable to test
20  [-h]              -- print out help and exit
21  [-k]              -- keep all intermediate files
22  [-v num]          -- set verbosity to num (used range 0..4, default: 2)
23  [-g]              -- generate result (*.res.gz.uu) files, only
24  [-r [crit%[val]]] -- report if status differences [of crit] > val (in %)
25  [-c regexp]       -- when comparing results, version must match this regexp
26  [-e [crit%[val]]] -- throw error if status difference [of crit] > val (in %)
27  [-a [crit]]       -- add status results [of crit] to result file
28  [-m]              -- add status result for current version to result file
29  [-t]              -- compute and call system("mtrack", 1) at the end, no diffs
30  [-tt max]         -- compute and call system("mtrack", max) at the end
31  [-T]              -- simply compute and determine timmings, no diffs
32  [file.lst]        -- read tst files from file.lst
33  [file.tst]        -- test Singular script file.tst
34_EOM_
35}
36
37#################################################################
38#
39# used programs
40#
41$sh="/bin/sh";
42$diff = "diff";
43$gunzip = "gunzip";
44$gzip = "gzip";
45$rm = "rm";
46$mv = "mv";
47$cp = "cp";
48$tr = "tr";
49$sed = "sed";
50$cat = "cat";
51$tee = "tee";
52$grep = "grep";
53
54sub mysystem
55{
56  local($call) = $_[0];
57  local($exit_status);
58
59  $call =~ s/"/\\"/g;
60  $call = "$sh -c \"$call\"";
61  print "$call\n" if ($verbosity > 2);
62  return (system $call);
63}
64
65sub mysystem_catch
66{
67  local($call) = $_[0];
68  local($output) = "";
69
70  $call = "$call > catch_$$";
71  & mysystem($call);
72
73  open(CATCH_FILE, "<catch_$$");
74  while (<CATCH_FILE>)
75  {
76    $output = $output.$_;
77  }
78  close(CATCH_FILE);
79  & mysystem("$rm -f catch_$$");
80  return $output;
81}
82
83$WINNT = 1 if (&mysystem("uname -a | $grep CYGWIN > /dev/null 2>&1") == 0);
84$uuencode = "uuencode";
85$uudecode = "uudecode";
86
87#
88# flush stdout and stderr after every write
89#
90select(STDERR);
91$| = 1;
92select(STDOUT);
93$| = 1;
94
95#################################################################
96#
97# the default settings
98#
99$singularOptions = "--ticks-per-sec=100 -teqsr12345678 --no-rc";
100# for testing under Windows, remove "e" option above and compile
101# res files on Linux, then copy to Windows and compare. Otherwise
102# you have problems with diff on Win. Just uncomment the next line:
103# $singularOptions = "--ticks-per-sec=100 -tqsr12345678 --no-rc";
104
105$keep = "no";
106$verbosity = 2;
107$generate = "no";
108$exit_code = 0;
109chop($curr_dir=`pwd`);
110# singular -- use the one in curr directory or the one found above
111$ext=".exe" if ($WINNT);
112$singular = "$curr_dir/Singular$ext";
113if ( (! (-e $singular)) || (! (-x $singular)))
114{
115  $singular = $curr_dir."/../Singular$ext";
116}
117# sed scripts which are applied to res files before they are diff'ed
118$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'";
119# default value (in %) above which differences are reported on -r
120$report_val = 5;
121# default value (in %) above which differences cause an error on -e
122$error_val = 5;
123# default value in 1/100 seconds, above which time differences are reported
124$mintime_val = 100;
125$hostname = &mysystem_catch("hostname");
126chop $hostname;
127
128#################################################################
129#
130# auxiallary routines
131#
132
133sub GetSingularVersionDate
134{
135  &mysystem("$singular -t -v --execute=\"exit;\"> SingularVersionDate");
136  open(FD, "<SingularVersionDate");
137  while (<FD>)
138  {
139    $singular_uname = (/for\s+([^\s]*)\s+/ ? $1 : "uname");
140    $singular_version = (/version\s+([^\s]*)\s+/ ? $1 : "0-0-0");
141    $singular_date = (/\((.*)\)/ ? $1 : "1970010100");
142    $this_time = time;
143    last;
144  }
145  close(FD);
146}
147
148sub Set_withMP
149{
150  if (! $withMP)
151  {
152    $withMP = "no";
153    open(MP_TEST, ">MPTest");
154    print(MP_TEST "system(\"with\", \"MP\"); \$");
155    close(MP_TEST);
156    &mysystem("$singular -qt MPTest > withMPtest");
157    if (open(MP_TEST, "<withMPtest"))
158    {
159      $_ = <MP_TEST>;
160      $withMP = "yes" if (/^1/);
161      close(MP_TEST);
162    }
163    &mysystem("$rm -f withMPtest MPTest");
164  }
165}
166
167
168sub MPok
169{
170  local($root) = $_[0];
171
172  if (! open(TST_FILE, "<$root.tst"))
173  {
174    print (STDERR "Can not open $root.tst for reading\n");
175    return (0);
176  }
177  while (<TST_FILE>)
178  {
179    if (/\"MP.+:.*\"/)
180    {
181      &Set_withMP;
182      return (0) if ($withMP eq "no");
183    }
184  }
185  return (1);
186}
187
188sub Diff
189{
190  local($root) = $_[0];
191  local($exit_status);
192
193  # prepare the result files:
194  &mysystem("$cat \"$root.res\" | $tr -d '\\013' | $sed $sed_scripts > \"$root.res.cleaned\"");
195  &mysystem("$cat \"$root.new.res\" | $tr -d '\\013' | $sed $sed_scripts > \"$root.new.res.cleaned\"");
196
197  # doo the diff call
198  $exit_status = &mysystem("$diff -w -b \"$root.res.cleaned\" \"$root.new.res.cleaned\" > \"$root.diff\" 2>&1");
199
200  # clean up time
201  &mysystem("$rm -f \"$root.res.cleaned\" \"$root.new.res.cleaned\"");
202
203  # there seems to be a bug here somewhere: even if diff reported
204  # differenceses and exited with status != 0, then system still
205  # returns exit status 0. Hence we manually need to find out whether
206  # or not differences were reported:
207  # iff diff-file exists and has non-zero size
208  $exit_status = $exit_status || (-e "$root.diff" && -s "$root.diff");
209
210  return($exit_status);
211}
212
213sub tst_status_check
214{
215  local($root) = $_[0];
216  local($line,$new_line,$prefix,$crit,$res,$new_res);
217  local($res_diff,$res_diff_pc,$res_diff_line);
218  my($exit_status, $reported) = (0, 0);
219  local($error_cause) = "";
220
221  open(RES_FILE, "<$root.stat") ||
222    return (1, "Can not open $root.stat \n");
223  open(NEW_RES_FILE, "<$root.new.stat") ||
224    return (1, "Can not open $root.new.stat \n");
225  open(STATUS_DIFF_FILE, ">$root.stat.sdiff") ||
226    return (1, "Can not open $root.stat.sdiff \n");
227
228  while (1)
229  {
230    while ($new_line = <NEW_RES_FILE>)
231    {
232      last if $new_line =~ /(\d+) >> (\w+) ::.*$hostname:(\d+)/ && $checks{$2};
233    }
234    last unless $new_line =~ /(\d+) >> (\w+) ::.*$hostname:(\d+)/;
235    $prefix = $1;
236    $crit = $2;
237    $new_res = $3;
238    next unless $new_res > $mintime_val;
239   
240    while ($line = <RES_FILE>)
241    {
242      last if $line =~ /$prefix >> $crit ::.*?$hostname:(\d+)/;
243    }
244    last unless $line =~ /$prefix >> $crit ::.*?$hostname:(\d+)/;
245    my $res_version;
246    $res = 0;
247
248    # search for smallest
249    while ($line =~ /([^\s]*)$hostname:(\d+)/g)
250    {
251      my $this_res = $2;
252      my $this_res_version = $1;
253      if ((!$res || $this_res <= $res) && (!$status_check_regexp  || $this_res_version =~ /$status_check_regexp/))
254      {
255        $res = $this_res;
256        $res_version = $this_res_version;
257      }
258    }
259    next unless $res;
260    $res_diff = $new_res - $res;
261    $res_diff_pc = int((($new_res / $res) - 1)*100);
262    $res_diff_line =
263      "$prefix >> $crit :: new:$new_res old:$res_version$res diff:$res_diff %:$res_diff_pc\n";
264    print STATUS_DIFF_FILE $res_diff_line;
265   
266    if ((defined($error{$crit}) &&  $error{$crit}<abs($res_diff_pc))
267        ||
268        (defined($report{$crit}) && $report{$crit}<abs($res_diff_pc)))
269    {
270      print "$prefix >> $crit :: new:$new_res old:$res diff:$res_diff %:$res_diff_pc\n"
271        if ($verbosity > 0);
272    }
273   
274    if ($exit_status == 0)
275    {
276      $exit_status = (defined($error{$crit})
277                      && $error{$crit} < abs($res_diff_pc));
278      $error_cause = "Status error for $crit at $prefix\n"
279        if ($exit_status);
280    }
281  }
282  close(RES_FILE);
283  close(NEW_RES_FILE);
284  close(STATUS_DIFF_FILE);
285  return ($exit_status, $error_cause);
286}
287
288sub tst_status_merge
289{
290  local($root) = $_[0];
291  local($line, $new_line, $crit, $res);
292
293  GetSingularVersionDate()
294    unless $singular_version;
295
296  if (! -e "$root.stat")
297  {
298    open(RES_FILE, ">$root.stat") ||
299      return (1, "Can not open $root.stat \n");
300    open(NEW_RES_FILE, "<$root.new.stat") ||
301      return (1, "Can not open $root.new.stat \n");
302
303    while (<NEW_RES_FILE>)
304    {
305      if (/(\d+) >> (\w+) :: /)
306      {
307        s/$hostname:(\d+)/$this_time:$singular_date:$singular_version:$singular_uname:$hostname:$1/g;
308        print RES_FILE $_;
309      }
310    }
311    close(RES_FILE);
312    close(NEW_RES_FILE);
313    return;
314  }
315
316  open(RES_FILE, "<$root.stat") ||
317    return (1, "Can not open $root.stat \n");
318  open(NEW_RES_FILE, "<$root.new.stat") ||
319    return (1, "Can not open $root.new.stat \n");
320  open(TEMP_FILE, ">$root.tmp.stat") ||
321    return (1, "Can not open $root.tmp.stat \n");
322
323  while (1)
324  {
325    while (($new_line = <NEW_RES_FILE>) && $new_line !~ /(\d+) >> (\w+) ::/){}
326    last unless $new_line =~ /(\d+) >> (\w+) ::.*$hostname:(\d+)/;
327    my $prefix = $1;
328    my $crit = $2;
329    my $new_res = "$this_time:$singular_date:$singular_version:$singular_uname:$hostname:$3";
330    while (($line = <RES_FILE>) && $line !~ /$prefix >> $crit ::/){}
331    unless ($line)
332    {
333      close(RES_FILE);
334      close(NEW_RES_FILE);
335      close(TEMP_FILE);
336      &mysystem("$rm \"$root.tmp.stat\"");
337      return (1, "Can not find '$prefix >> $crit' in $root.stat\n");
338    }
339    if ($merge_version)
340    {
341      $line =~ s/[^ ]*:$singular_version:$singular_uname:$hostname:\d+//g;
342      chop $line;
343      $line .= " $new_res\n";
344    }
345    else
346    {
347      chop $line;
348      $line .= " $new_res\n";
349    }
350    print TEMP_FILE $line;
351  }
352 
353  close(RES_FILE);
354  close(NEW_RES_FILE);
355  close(TEMP_FILE);
356  &mysystem("$mv -f \"$root.tmp.stat\" \"$root.stat\"");
357  &mysystem("$rm -f \"$root.new.stat\" \"$root.stat.sdiff\"") unless $keep eq "yes";
358  return ;
359}
360
361sub tst_check
362{
363  local($root) = $_[0];
364  local($system_call, $exit_status, $ignore_pattern, $error_cause);
365
366  print "--- $root " unless ($verbosity == 0);
367  $total_checks++;
368 
369  # check for existence/readablity of tst and res file
370  if (! (-r "$root.tst"))
371  {
372    print (STDERR "Can not read $root.tst\n");
373    return (1);
374  }
375
376  # ignore MP stuff, if this singular does not have MP
377  if (! &MPok($root))
378  {
379    print "Warning: $root not tested: needs MP\n";
380    return (0);
381  }
382
383  # generate $root.res
384  if ($generate ne "yes" && ! defined($mtrack) && !defined($timings_only))
385  {
386    if ((-r "$root.res.gz.uu") && ! ( -z "$root.res.gz.uu"))
387    {
388      $exit_status = &mysystem("$uudecode \"$root.res.gz.uu\" > /dev/null 2>&1; $gunzip -f \"$root.res.gz\"");
389      if ($exit_status)
390      {
391        print (STDERR "Can not decode $root.res.gz.uu\n");
392        return ($exit_status);
393      }
394    }
395    elsif (! (-r "$root.res") || ( -z "$root.res"))
396    {
397      print (STDERR "Can not read $root.res[.gz.uu]\n");
398      return (1);
399    }
400  }
401
402  my $resfile = "\"$root.new.res\"";
403  $resfile = "\"$root.mtrack.res\"" if (defined($mtrack));
404  my $statfile = "$root.new.stat";
405  &mysystem("$rm -f \"$statfile\"");
406  if (defined($mtrack))
407  {
408    $system_call = "$cat \"$root.tst\" | sed -e 's/\\\\\$/LIB \"general.lib\"; killall(); killall(\"proc\");kill killall;system(\"mtrack\", \"$root.mtrack.unused\", $mtrack); \\\$/' | $singular $singularOptions ";
409    $system_call .= ($verbosity > 3 ? " | $tee " : " > ");
410    $system_call .= "\"$root.mtrack.res\"";
411    $system_call .= " 2>&1 " if ($verbosity <= 3);
412  }
413  else
414  {
415   
416    # prepare Singular run
417    if ($verbosity > 3 && !$WINNT)
418    {
419      $system_call = "$cat \"$root.tst\" | $singular --execute 'string tst_status_file=\"$statfile\";' $singularOptions | $tee $resfile";
420    }
421    else
422    {
423      $system_call = "$cat \"$root.tst\" | $singular --execute 'string tst_status_file=\"$statfile\";' $singularOptions > $resfile 2>&1";
424    }
425  }
426  # Go Singular, Go!
427 
428  my ($user_t,$system_t,$cuser_t,$csystem_t) = times;
429  $exit_status = &mysystem($system_call);
430  my ($user_t,$system_t,$cuser_t2,$csystem_t2) = times;
431  $cuser_t = $cuser_t2 - $cuser_t;
432  $csystem_t = $csystem_t2 - $csystem_t;
433  if ($exit_status != 0)
434  {
435    $error_cause = "Singular call exited with status != 0";
436  }
437  else
438  {
439    # check for Segment fault in res file
440    $exit_status = ! (&mysystem("$grep \"Segment fault\" $resfile > /dev/null 2>&1"));
441
442    if ($exit_status)
443    {
444      $error_cause = "Segment fault";
445    }
446    elsif (! defined($mtrack) && !defined($timings_only))
447    {
448      &mysystem("$rm -f \"$root.diff\"");
449      if ($generate eq "yes")
450      {
451        &mysystem("$cp $resfile \"$root.res\"");
452      }
453      else
454      {
455        # call Diff
456        $exit_status = &Diff($root);
457        if ($exit_status)
458        {
459          unless ($verbosity == 0)
460          {
461            print "\n";
462            mysystem("$cat \"$root.diff\"");
463          }
464          $error_cause = "Differences in res files";
465        }
466        else
467        {
468          &mysystem("$rm -f \"$root.diff\"");
469        }
470      }
471    }
472  }
473
474
475
476  mysystem("mv tst_status.out \"$statfile\"")
477    if (! -e $statfile && -e "tst_status.out");
478
479  if (%checks && ! $exit_status && $generate ne "yes" && ! defined($mtrack))
480  {
481    if (-e "$statfile")
482    {
483      # do status checks
484      ($exit_status, $error_cause) = & tst_status_check($root);
485    }
486    else
487    {
488      print "Warning: no file $statfile\n";
489    }
490  }
491
492
493  # complain even if verbosity == 0
494  if ($exit_status)
495  {
496    if (! -e "$root.diff")
497    {
498      open (DIFF_FILE, ">$root.diff");
499      print DIFF_FILE "!!! $root : $error_cause\n";
500      print "\n";
501    }
502    print STDERR "!!! $root : $error_cause\n";
503  }
504  else
505  {
506    unless (defined($mtrack))
507    {
508      #clean up
509      if ($generate eq "yes")
510      {
511        mysystem("$rm -f \"$root.stat\"") unless %merge;
512        ($exit_status, $error_cause) = tst_status_merge($root);
513        if (! $WINNT)
514        {
515          &mysystem("$gzip -cf \"$root.res\" | $uuencode \"$root.res.gz\" > \"$root.res.gz.uu\"");
516        }
517        else
518        {
519          # uuencode is broken under windows
520          print "Warning: Can not generate $root.res.gz.uu under Windows\n";
521        }
522      }
523      elsif (%merge)
524      {
525        ($exit_status, $error_cause) = & tst_status_merge($root);
526         
527        print (STDERR "Warning: Merge Problems: $error_cause\n")
528          if ($verbosity > 0 && $exit_status);
529      }
530    }
531    if ($keep ne "yes")
532    {
533      &mysystem("$rm -f tst_status.out $resfile \"$root.res\" \"$root.diff\" \"$root.new.stat\"");
534    }
535  }
536  # und tschuess
537  unless ($verbosity == 0 || $exit_status)
538  {
539    if ($verbosity > 1 || $timings_only)
540    {
541      my $used_time = $cuser_t + $csystem_t;
542      $total_used_time += $used_time;
543      $lst_used_time += $used_time;
544      print " " x (23 - length($root));
545      printf("%.2f", $used_time);
546    }
547    print " \n";
548  }
549  $total_checks_pass++ unless $exit_status;
550
551  mysystem("mv gmon.out \"gmon.$root.out\"")
552    if (-e "gmon.out");
553
554  return ($exit_status);
555}
556
557
558#################################################################
559#
560# Main program
561#
562
563# process switches
564while ($ARGV[0] =~ /^-/)
565{
566  $_ = shift;
567  if (/^-s$/)
568  {
569    $singular = shift;
570  }
571  elsif (/^-h$/)
572  {
573    &Usage && exit (0);
574  }
575  elsif (/^-k$/)
576  {
577    $keep = "yes";
578  }
579  elsif (/^-g$/)
580  {
581    $generate = "yes";
582  }
583  elsif(/^-v$/)
584  {
585    $verbosity = shift;
586  }
587  elsif (/^-tt/)
588  {
589    $mtrack = shift;
590  }
591  elsif(/^-t$/)
592  {
593    $mtrack = 1;
594  }
595  elsif (/^-T/)
596  {
597    $timings_only = 1;
598  }
599  elsif(/^-r$/)
600  {
601    $crit = "all";
602    $val = $report_val;
603    if ($ARGV[0] =~ /.*%.*/)
604    {
605      ($crit, $val) = split(/%/, shift);
606    }
607    elsif ($ARGV[0] &&
608           $ARGV[0] !~ /^-/ && $ARGV[0] !~ /.*\.tst/ && $ARGV[0] !~ /.*\.lst/)
609    {
610      $crit = shift;
611    }
612    if ($crit eq "all")
613    {
614      $report{"tst_memory_0"} = $val;
615      $report{"tst_memory_1"} = $val;
616      $report{"tst_memory_2"} = $val;
617      $report{"tst_timer"} = $val;
618      $report{"tst_timer_1"} = $val;
619      $checks{"tst_memory_0"} = 1;
620      $checks{"tst_memory_1"} = 1;
621      $checks{"tst_memory_2"} =  1;
622      $checks{"tst_timer"} =  1;
623      $checks{"tst_timer_1"} =  1;
624    }
625    else
626    {
627      $report{$crit} = $val;
628      $checks{$crit} = 1;
629    }
630  }
631  elsif(/^-e$/)
632  {
633    $crit = "all";
634    $val = $error_val;
635    if ($ARGV[0] =~ /.*%.*/)
636    {
637      ($crit, $val) = split(/%/, shift);
638    }
639    elsif ($ARGV[0] &&
640            $ARGV[0] !~ /^-/ && $ARGV[0] !~ /.*\.tst/ && $ARGV[0] !~ /.*\.lst/)
641    {
642      $crit = shift;
643    }
644    if ($crit eq "all")
645    {
646      $error{"tst_memory_0"} = $val;
647      $error{"tst_memory_1"} = $val;
648      $error{"tst_memory_2"} = $val;
649      $error{"tst_timer"} = $val;
650      $error{"tst_timer_1"} = $val;
651      $checks{"tst_memory_0"} = 1;
652      $checks{"tst_memory_1"} = 1;
653      $checks{"tst_memory_2"} =  1;
654      $checks{"tst_timer"} =  1;
655      $checks{"tst_timer_1"} =  1;
656    }
657    else
658    {
659      $error{$crit} = $val;
660      $checks{$crit} = 1;
661    }
662  }
663  elsif(/^-a/ || /^-m/)
664  {
665    $merge_version = 1 if /^-m/;
666    if ($ARGV[0] &&
667        $ARGV[0] !~ /^-/ && $ARGV[0] !~ /.*\.tst/ && $ARGV[0] !~ /.*\.lst/)
668    {
669      $crit = shift;
670      $merge{$crit} = 1;
671    }
672    else
673    {
674      $merge{"tst_memory_0"} = 1;
675      $merge{"tst_memory_1"} = 1;
676      $merge{"tst_memory_2"} =  1;
677      $merge{"tst_timer"} =  1;
678      $merge{"tst_timer_1"} =  1;
679    }
680  }
681  elsif (/^-c/)
682  {
683    $status_check_regexp = shift;
684  }
685  else
686  {
687    print (STDERR "Unrecognised option: $_\n") && &Usage && die;
688  }
689}
690
691# if no command line arguments are left, use regress.lst
692if ($#ARGV == -1)
693{
694  $ARGV[0] = "regress.lst";
695}
696
697# make sure $singular exists and is executable
698$singular = "$curr_dir/$singular" unless ($singular =~ /^\/.*/);
699
700if ( ! (-e $singular))
701{
702  $singular = "$singular$ext"   if ($WINNT && $singular !~ /.*$ext$/);
703}
704
705if ( ! (-e $singular))
706{
707  print (STDERR "Can not find $singular \n") && &Usage && die;
708}
709
710if (! (-x $singular) && (! WINNT))
711{
712  print (STDERR "Can not execute $singular \n") && &Usage && die;
713}
714if (-d $singular)
715{
716  print (STDERR "$singular is a directory\n") && &Usage && die;
717}
718
719
720# now do the work
721foreach (@ARGV)
722{
723
724  if ( /^(.*)\.([^\.\/]*)$/ )
725  {
726    $_ = $1;
727    $extension = $2;
728  }
729
730  if ( /^(.*)\/([^\/]*)$/ )
731  {
732    $path = $1;
733    $base = $2;
734    chdir($path);
735    print "cd $path\n" if ($verbosity > 2);
736  }
737  else
738  {
739    $path = "";
740    $base = $_;
741  }
742  $file = "$base.$extension";
743  chop ($tst_curr_dir = `pwd`);
744
745  if ($extension eq "tst")
746  {
747    $exit_code = &tst_check($base) || $exit_code;
748  }
749  elsif ($extension eq "lst")
750  {
751   
752    if (! open(LST_FILE, "<$file"))
753    {
754      print (STDERR "Can not open $path/$file for reading\n");
755      $exit_code = 1;
756      next;
757    }
758    $lst_used_time = 0;
759    $lst_checks = 0;
760    $lst_checks_pass = 0;
761    while (<LST_FILE>)
762    {
763      if (/^;/)          # ignore lines starting with ;
764      {
765        print unless ($verbosity == 0);
766        next;
767      }
768      next if (/^\s*$/); #ignore whitespaced lines
769      chop if (/\n$/);   #chop of \n
770
771      $_ = $1 if (/^(.*)\.([^\.\/]*)$/ ); # chop of extension
772      if ( /^(.*)\/([^\/]*)$/ )
773      {
774        $tst_path = $1;
775        $tst_base = $2;
776        chdir($tst_path);
777        print "cd $tst_path\n" if ($verbosity > 2);
778      }
779      else
780      {
781        $tst_path = "";
782        $tst_base = $_;
783      }
784      $tst_base =~ s/^\s*//;
785      $tst_base =~ s/(.*?)\s+.*/$1/;
786      $lst_checks++;
787      my $this_exit_code = &tst_check($tst_base);
788      $lst_checks_pass++ unless $this_exit_code;
789      $exit_code = $this_exit_code || $exit_code;
790
791      if ($tst_path ne "")
792      {
793        chdir($tst_curr_dir);
794        print "cd $tst_curr_dir\n" if ($verbosity > 2);
795      }
796    }
797    close (LST_FILE);
798    printf("$base Summary: Checks:$lst_checks Failed:%d Time:%.2f\n", $lst_checks - $lst_checks_pass, $lst_used_time)
799      unless ($verbosity < 2)
800  }
801  else
802  {
803    print (STDERR "Unknown extension of $_: Need extension lst or tst\n");
804    $exit_code = 1;
805  }
806  if ($path ne "")
807  {
808    chdir($curr_dir);
809    print "cd $curr_dir\n" if ($verbosity > 2);
810  }
811}
812
813unless ($verbosity < 2 || $lst_checks == $total_checks)
814{
815  printf("Summary: Checks:$total_checks Failed:%d Time:%.2f\n", $total_checks - $total_checks_pass, $total_used_time);
816}
817
818# Und Tschuess
819exit $exit_code;
820
821
Note: See TracBrowser for help on using the repository browser.