cvs commit: httpd-test/perl-framework/Apache-Test/lib/Apache TestRun.pm

[stas]

stas        2003/10/20 17:45:00

  Modified:    perl-framework/Apache-Test/lib/Apache TestRun.pm
  Log:
  speedup the core scan function, by telling File::Find not to chdir into
  sub-dirs
  
  Revision  Changes    Path
  1.117     +11 -6     
httpd-test/perl-framework/Apache-Test/lib/Apache/TestRun.pm
  
  Index: TestRun.pm
  ===================================================================
  RCS file: 
/home/cvs/httpd-test/perl-framework/Apache-Test/lib/Apache/TestRun.pm,v
  retrieving revision 1.116
  retrieving revision 1.117
  diff -u -u -r1.116 -r1.117
  --- TestRun.pm        20 Oct 2003 20:09:05 -0000      1.116
  +++ TestRun.pm        21 Oct 2003 00:45:00 -0000      1.117
  @@ -13,6 +13,7 @@
   
   use File::Find qw(finddepth);
   use File::Spec::Functions qw(catfile);
  +use File::Basename qw(basename);
   use Getopt::Long qw(GetOptions);
   use Config;
   
  @@ -638,9 +639,11 @@
       my $times = 0;
       my @msg = ();
   
  -    finddepth(sub {
  +    finddepth({ no_chdir => 1,
  +                wanted   => sub {
           return unless -f $_;
  -        return unless /$core_pat/o;
  +        my $file = basename $File::Find::name;
  +        return unless $file =~ /$core_pat/o;
           my $core = $File::Find::name;
           unless (exists $core_files{$core} && $core_files{$core} == -M $core) 
{
               # new core file!
  @@ -658,7 +661,7 @@
               push @msg, "oh $oh, server dumped core $again",
                   "for stacktrace, run: gdb $vars->{httpd} -core $core";
           }
  -    }, $vars->{top_dir});
  +    }}, $vars->{top_dir});
   
       return @msg;
   
  @@ -669,9 +672,11 @@
       my $vars = $self->{test_config}->{vars};
       my $times = 0;
   
  -    finddepth(sub {
  +    finddepth({ no_chdir => 1,
  +                wanted   => sub {
           return unless -f $_;
  -        return unless /$core_pat/o;
  +        my $file = basename $File::Find::name;
  +        return unless $file =~ /$core_pat/o;
           my $core = $File::Find::name;
           if (exists $core_files{$core} && $core_files{$core} == -M $core) {
               # we have seen this core file before the start of the test
  @@ -683,7 +688,7 @@
               error "oh $oh, server dumped core $again";
               error "for stacktrace, run: gdb $vars->{httpd} -core $core";
           }
  -    }, $vars->{top_dir});
  +    }}, $vars->{top_dir});
   }
   
   # warn the user that there is a core file before the tests