source: git/Tst/regress.cmd @ 6dc21d

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