of course the custom gdb script shouldn't be deleted at the end of the
session, silly me :) here is a new patch:
Index: Apache-Test/lib/Apache/TestRun.pm
===================================================================
RCS file:
/home/cvs/httpd-test/perl-framework/Apache-Test/lib/Apache/TestRun.pm,v
retrieving revision 1.69
diff -u -r1.69 TestRun.pm
--- Apache-Test/lib/Apache/TestRun.pm 2001/11/22 03:11:38 1.69
+++ Apache-Test/lib/Apache/TestRun.pm 2001/11/22 09:24:42
@@ -17,7 +17,7 @@
my @std_run = qw(start-httpd run-tests stop-httpd);
my @others = qw(verbose configure clean help ssl http11);
my @flag_opts = (@std_run, @others);
-my @string_opts = qw(order);
+my @string_opts = qw(order commands);
my @ostring_opts = qw(proxy ping);
my @debug_opts = qw(debug);
my @num_opts = qw(times);
@@ -41,6 +41,7 @@
'postamble' => 'config to add at the end of httpd.conf',
'ping[=block]' => 'test if server is running or port in use',
'debug[=name]' => 'start server under debugger name (e.g. gdb, ddd,
...)',
+ 'commands=file' => 'use the file with gdb commands file in debug mode',
'breakpoint=bp' => 'set breakpoints (multiply bp can be set)',
'header' => "add headers to (".join('|', @request_opts).")
request",
'http11' => 'run all tests with HTTP/1.1 (keep alive) requests',
@@ -202,8 +203,8 @@
$opts{debug} = 1;
}
- # breakpoint automatically turns the debug mode on
- if (@{ $opts{breakpoint} }) {
+ # breakpoint/commands automatically turns the debug mode on
+ if (@{ $opts{breakpoint} } || exists $opts{commands}) {
$opts{debug} ||= 1;
}
@@ -683,7 +684,7 @@
my $opts = $self->{opts};
my $debug_opts = {};
- for (qw(debugger breakpoint)) {
+ for (qw(debugger breakpoint commands)) {
$debug_opts->{$_} = $opts->{$_};
}
Index: Apache-Test/lib/Apache/TestServer.pm
===================================================================
RCS file:
/home/cvs/httpd-test/perl-framework/Apache-Test/lib/Apache/TestServer.pm,v
retrieving revision 1.41
diff -u -r1.41 TestServer.pm
--- Apache-Test/lib/Apache/TestServer.pm 2001/11/22 03:13:04 1.41
+++ Apache-Test/lib/Apache/TestServer.pm 2001/11/22 09:24:42
@@ -152,25 +152,45 @@
my $config = $self->{config};
my $args = $self->args;
my $one_process = $self->version_of(\%one_process);
+ my $server_root = $config->{vars}->{serverroot};
- my $file = catfile $config->{vars}->{serverroot}, '.gdb-test-start';
- my $fh = $config->genfile($file);
-
- print $fh default_gdbinit();
-
- if (@breakpoints) {
- print $fh "b ap_run_pre_config\n";
- print $fh "run $one_process $args\n";
- print $fh "finish\n";
- for (@breakpoints) {
- print $fh "b $_\n"
+ my $custom_file = '';
+ # try to find the user-defined debug script as is, in t/ and t/../
+ if (my $commands = $opts->{commands}) {
+ for my $try_file ($commands,
+ map {catfile $server_root, $_, $commands} qw(. ..)) {
+ next unless -e $try_file;
+ $custom_file = $try_file;
+ warning "using $custom_file debug script";
}
- print $fh "continue\n";
+ warning "cannot find $commands, using default" unless $custom_file;
+ }
+
+ my $file;
+ if ($custom_file) {
+ $file = $custom_file;
}
else {
- print $fh "run $one_process $args\n";
+ # provide the default debug script
+ $file = catfile $server_root, '.gdb-test-start';
+ my $fh = $config->genfile($file);
+
+ print $fh default_gdbinit();
+
+ if (@breakpoints) {
+ print $fh "b ap_run_pre_config\n";
+ print $fh "run $one_process $args\n";
+ print $fh "finish\n";
+ for (@breakpoints) {
+ print $fh "b $_\n"
+ }
+ print $fh "continue\n";
+ }
+ else {
+ print $fh "run $one_process $args\n";
+ }
+ close $fh;
}
- close $fh;
my $command;
my $httpd = $config->{vars}->{httpd};
@@ -186,7 +206,8 @@
debug $command;
system $command;
- unlink $file;
+ # remove only generated file (genfile() won't do this on aborted gdb)
+ unlink $file unless $custom_file;
}
sub debugger_file {
_____________________________________________________________________
Stas Bekman JAm_pH -- Just Another mod_perl Hacker
http://stason.org/ mod_perl Guide http://perl.apache.org/guide
mailto:[EMAIL PROTECTED] http://ticketmaster.com http://apacheweek.com
http://singlesheaven.com http://perl.apache.org http://perlmonth.com/
