stas 2003/10/20 18:18:53
Modified: perl-framework/Apache-Test/lib/Apache TestRun.pm
TestSmoke.pm
Log:
an optional core scanning of only t/ dir (used by TestSmoke)
Revision Changes Path
1.118 +24 -7
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.117
retrieving revision 1.118
diff -u -u -r1.117 -r1.118
--- TestRun.pm 21 Oct 2003 00:45:00 -0000 1.117
+++ TestRun.pm 21 Oct 2003 01:18:53 -0000 1.118
@@ -629,16 +629,35 @@
#e.g. t/core or t/core.12499
my $core_pat = '^core(\.\d+)?' . "\$";
+# $self->scan_core_incremental([$only_top_dir])
# normally would be called after each test
# and since it updates the list of seen core files
# scan_core() won't report these again
# currently used in Apache::TestSmoke
+#
+# if $only_t_dir arg is true only the t_dir dir (t/) will be scanned
sub scan_core_incremental {
- my $self = shift;
+ my($self, $only_t_dir) = @_;
my $vars = $self->{test_config}->{vars};
- my $times = 0;
- my @msg = ();
+ if ($only_t_dir) {
+ require IO::Dir;
+ my @cores = ();
+ for (IO::Dir->new($vars->{t_dir})->read) {
+ next unless -f;
+ next unless /$core_pat/o;
+ my $core = catfile $vars->{t_dir}, $_;
+ next if exists $core_files{$core} && $core_files{$core} == -M
$core;
+ $core_files{$core} = -M $core;
+ push @cores, $core;
+ }
+ return @cores
+ ? join "\n", "server dumped core, for stacktrace, run:",
+ map { "gdb $vars->{httpd} -core $_" } @cores
+ : ();
+ }
+
+ my @msg = ();
finddepth({ no_chdir => 1,
wanted => sub {
return unless -f $_;
@@ -656,10 +675,8 @@
# other unique identifier, in case the same test is run
# more than once and each time it caused a segfault
$core_files{$core} = -M $core;
- my $oh = oh();
- my $again = $times++ ? "again" : "";
- push @msg, "oh $oh, server dumped core $again",
- "for stacktrace, run: gdb $vars->{httpd} -core $core";
+ push @msg, "server dumped core, for stacktrace, run:\n" .
+ "gdb $vars->{httpd} -core $core";
}
}}, $vars->{top_dir});
1.26 +1 -1
httpd-test/perl-framework/Apache-Test/lib/Apache/TestSmoke.pm
Index: TestSmoke.pm
===================================================================
RCS file:
/home/cvs/httpd-test/perl-framework/Apache-Test/lib/Apache/TestSmoke.pm,v
retrieving revision 1.25
retrieving revision 1.26
diff -u -u -r1.25 -r1.26
--- TestSmoke.pm 20 Oct 2003 20:09:05 -0000 1.25
+++ TestSmoke.pm 21 Oct 2003 01:18:53 -0000 1.26
@@ -503,7 +503,7 @@
IPC::Run3::run3($test_command, undef, \$log, \$log);
my $ok = ($log =~ /All tests successful/) ? 1 : 0;
- my @core_files_msg =
$self->Apache::TestRun::scan_core_incremental;
+ my @core_files_msg =
$self->Apache::TestRun::scan_core_incremental(1);
# if the test has caused core file(s) it's not ok
$ok = 0 if @core_files_msg;
