source: git/Tst/regress.cmd @ 56ae4f

spielwiese
Last change on this file since 56ae4f was 56ae4f, checked in by Hans Schönemann <hannes@…>, 20 years ago
*hannes: 2-0 port: -s git-svn-id: file:///usr/local/Singular/svn/trunk@7037 2c84dea3-7e68-4137-9b89-c4e89433aadc
  • Property mode set to 100755
File size: 19.6 KB
Line 
1#!/usr/bin/perl
2
3#################################################################
4# $Id: regress.cmd,v 1.39 2004-02-12 13:00:24 Singular 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);
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  mysystem("mv tst_status.out $statfile")
475    if (! -e $statfile && -e "tst_status.out");
476
477  if (%checks && ! $exit_status && $generate ne "yes" && ! defined($mtrack))
478  {
479    if (-e "$statfile")
480    {
481      # do status checks
482      ($exit_status, $error_cause) = & tst_status_check($root);
483    }
484    else
485    {
486      print "Warning: no file $statfile\n";
487    }
488  }
489
490
491  # complain even if verbosity == 0
492  if ($exit_status)
493  {
494    if (! -e "$root.diff")
495    {
496      open (DIFF_FILE, ">$root.diff");
497      print DIFF_FILE "!!! $root : $error_cause\n";
498      print "\n";
499    }
500    print STDERR "!!! $root : $error_cause\n";
501  }
502  else
503  {
504    unless (defined($mtrack))
505    {
506      #clean up
507      if ($generate eq "yes")
508      {
509        mysystem("$rm -f $root.stat") unless %merge;
510        ($exit_status, $error_cause) = tst_status_merge($root);
511        if (! $WINNT)
512        {
513          &mysystem("$gzip -cf $root.res | $uuencode $root.res.gz > $root.res.gz.uu");
514        }
515        else
516        {
517          # uuencode is broken under windows
518          print "Warning: Can not generate $root.res.gz.uu under Windows\n";
519        }
520      }
521      elsif (%merge)
522      {
523        ($exit_status, $error_cause) = & tst_status_merge($root);
524         
525        print (STDERR "Warning: Merge Problems: $error_cause\n")
526          if ($verbosity > 0 && $exit_status);
527      }
528    }
529    if ($keep ne "yes")
530    {
531      &mysystem("$rm -f tst_status.out $resfile $root.res $root.diff $root.new.stat");
532    }
533  }
534  # und tschuess
535  unless ($verbosity == 0 || $exit_status)
536  {
537    if ($verbosity > 1 || $timings_only)
538    {
539      my $used_time = $cuser_t + $csystem_t;
540      $total_used_time += $used_time;
541      $lst_used_time += $used_time;
542      print " " x (23 - length($root));
543      printf("%.2f", $used_time);
544    }
545    print " \n";
546  }
547  $total_checks_pass++ unless $exit_status;
548  return ($exit_status);
549}
550
551
552#################################################################
553#
554# Main program
555#
556
557# process switches
558while ($ARGV[0] =~ /^-/)
559{
560  $_ = shift;
561  if (/^-s$/)
562  {
563    $singular = shift;
564  }
565  elsif (/^-h$/)
566  {
567    &Usage && exit (0);
568  }
569  elsif (/^-k$/)
570  {
571    $keep = "yes";
572  }
573  elsif (/^-g$/)
574  {
575    $generate = "yes";
576  }
577  elsif(/^-v$/)
578  {
579    $verbosity = shift;
580  }
581  elsif (/^-tt/)
582  {
583    $mtrack = shift;
584  }
585  elsif(/^-t$/)
586  {
587    $mtrack = 1;
588  }
589  elsif (/^-T/)
590  {
591    $timings_only = 1;
592  }
593  elsif(/^-r$/)
594  {
595    $crit = "all";
596    $val = $report_val;
597    if ($ARGV[0] =~ /.*%.*/)
598    {
599      ($crit, $val) = split(/%/, shift);
600    }
601    elsif ($ARGV[0] &&
602           $ARGV[0] !~ /^-/ && $ARGV[0] !~ /.*\.tst/ && $ARGV[0] !~ /.*\.lst/)
603    {
604      $crit = shift;
605    }
606    if ($crit eq "all")
607    {
608      $report{"tst_memory_0"} = $val;
609      $report{"tst_memory_1"} = $val;
610      $report{"tst_memory_2"} = $val;
611      $report{"tst_timer"} = $val;
612      $report{"tst_timer_1"} = $val;
613      $checks{"tst_memory_0"} = 1;
614      $checks{"tst_memory_1"} = 1;
615      $checks{"tst_memory_2"} =  1;
616      $checks{"tst_timer"} =  1;
617      $checks{"tst_timer_1"} =  1;
618    }
619    else
620    {
621      $report{$crit} = $val;
622      $checks{$crit} = 1;
623    }
624  }
625  elsif(/^-e$/)
626  {
627    $crit = "all";
628    $val = $error_val;
629    if ($ARGV[0] =~ /.*%.*/)
630    {
631      ($crit, $val) = split(/%/, shift);
632    }
633    elsif ($ARGV[0] &&
634            $ARGV[0] !~ /^-/ && $ARGV[0] !~ /.*\.tst/ && $ARGV[0] !~ /.*\.lst/)
635    {
636      $crit = shift;
637    }
638    if ($crit eq "all")
639    {
640      $error{"tst_memory_0"} = $val;
641      $error{"tst_memory_1"} = $val;
642      $error{"tst_memory_2"} = $val;
643      $error{"tst_timer"} = $val;
644      $error{"tst_timer_1"} = $val;
645      $checks{"tst_memory_0"} = 1;
646      $checks{"tst_memory_1"} = 1;
647      $checks{"tst_memory_2"} =  1;
648      $checks{"tst_timer"} =  1;
649      $checks{"tst_timer_1"} =  1;
650    }
651    else
652    {
653      $error{$crit} = $val;
654      $checks{$crit} = 1;
655    }
656  }
657  elsif(/^-a/ || /^-m/)
658  {
659    $merge_version = 1 if /^-m/;
660    if ($ARGV[0] &&
661        $ARGV[0] !~ /^-/ && $ARGV[0] !~ /.*\.tst/ && $ARGV[0] !~ /.*\.lst/)
662    {
663      $crit = shift;
664      $merge{$crit} = 1;
665    }
666    else
667    {
668      $merge{"tst_memory_0"} = 1;
669      $merge{"tst_memory_1"} = 1;
670      $merge{"tst_memory_2"} =  1;
671      $merge{"tst_timer"} =  1;
672      $merge{"tst_timer_1"} =  1;
673    }
674  }
675  elsif (/^-c/)
676  {
677    $status_check_regexp = shift;
678  }
679  else
680  {
681    print (STDERR "Unrecognised option: $_\n") && &Usage && die;
682  }
683}
684
685# if no command line arguments are left, use regress.lst
686if ($#ARGV == -1)
687{
688  $ARGV[0] = "regress.lst";
689}
690
691# make sure $singular exists and is executable
692$singular = "$curr_dir/$singular" unless ($singular =~ /^\/.*/);
693
694if ( ! (-e $singular))
695{
696  $singular = "$singular$ext"   if ($WINNT && $singular !~ /.*$ext$/);
697}
698
699if ( ! (-e $singular))
700{
701  print (STDERR "Can not find $singular \n") && &Usage && die;
702}
703
704if (! (-x $singular) && (! WINNT))
705{
706  print (STDERR "Can not execute $singular \n") && &Usage && die;
707}
708if (-d $singular)
709{
710  print (STDERR "$singular is a directory\n") && &Usage && die;
711}
712
713
714# now do the work
715foreach (@ARGV)
716{
717
718  if ( /^(.*)\.([^\.\/]*)$/ )
719  {
720    $_ = $1;
721    $extension = $2;
722  }
723
724  if ( /^(.*)\/([^\/]*)$/ )
725  {
726    $path = $1;
727    $base = $2;
728    chdir($path);
729    print "cd $path\n" if ($verbosity > 2);
730  }
731  else
732  {
733    $path = "";
734    $base = $_;
735  }
736  $file = "$base.$extension";
737  chop ($tst_curr_dir = `pwd`);
738
739  if ($extension eq "tst")
740  {
741    $exit_code = &tst_check($base) || $exit_code;
742  }
743  elsif ($extension eq "lst")
744  {
745   
746    if (! open(LST_FILE, "<$file"))
747    {
748      print (STDERR "Can not open $path/$file for reading\n");
749      $exit_code = 1;
750      next;
751    }
752    $lst_used_time = 0;
753    $lst_checks = 0;
754    $lst_checks_pass = 0;
755    while (<LST_FILE>)
756    {
757      if (/^;/)          # ignore lines starting with ;
758      {
759        print unless ($verbosity == 0);
760        next;
761      }
762      next if (/^\s*$/); #ignore whitespaced lines
763      chop if (/\n$/);   #chop of \n
764
765      $_ = $1 if (/^(.*)\.([^\.\/]*)$/ ); # chop of extension
766      if ( /^(.*)\/([^\/]*)$/ )
767      {
768        $tst_path = $1;
769        $tst_base = $2;
770        chdir($tst_path);
771        print "cd $tst_path\n" if ($verbosity > 2);
772      }
773      else
774      {
775        $tst_path = "";
776        $tst_base = $_;
777      }
778      $tst_base =~ s/^\s*//;
779      $tst_base =~ s/(.*?)\s+.*/$1/;
780      $lst_checks++;
781      my $this_exit_code = &tst_check($tst_base);
782      $lst_checks_pass++ unless $this_exit_code;
783      $exit_code = $this_exit_code || $exit_code;
784
785      if ($tst_path ne "")
786      {
787        chdir($tst_curr_dir);
788        print "cd $tst_curr_dir\n" if ($verbosity > 2);
789      }
790    }
791    close (LST_FILE);
792    printf("$base Summary: Checks:$lst_checks Failed:%d Time:%.2f\n", $lst_checks - $lst_checks_pass, $lst_used_time)
793      unless ($verbosity < 2)
794  }
795  else
796  {
797    print (STDERR "Unknown extension of $_: Need extension lst or tst\n");
798    $exit_code = 1;
799  }
800  if ($path ne "")
801  {
802    chdir($curr_dir);
803    print "cd $curr_dir\n" if ($verbosity > 2);
804  }
805}
806
807unless ($verbosity < 2 || $lst_checks == $total_checks)
808{
809  printf("Summary: Checks:$total_checks Failed:%d Time:%.2f\n", $total_checks - $total_checks_pass, $total_used_time);
810}
811
812# Und Tschuess
813exit $exit_code;
814
815
Note: See TracBrowser for help on using the repository browser.