the previous patch had a flow :( (always started gdb)
here is a correct one:
Index: Apache-Test/lib/Apache/TestRun.pm
===================================================================
RCS file: /home/cvs/modperl-2.0/Apache-Test/lib/Apache/TestRun.pm,v
retrieving revision 1.10
diff -u -r1.10 TestRun.pm
--- Apache-Test/lib/Apache/TestRun.pm 2001/06/27 06:21:24 1.10
+++ Apache-Test/lib/Apache/TestRun.pm 2001/07/19 16:28:56
@@ -16,27 +16,30 @@
my @others = qw(verbose configure clean help ping);
my @flag_opts = (@std_run, @others);
my @string_opts = qw(order);
+my @debug_opts = qw(debug);
my @num_opts = qw(times);
-my @list_opts = qw(preamble postamble);
+my @list_opts = qw(preamble postamble breakpoint);
my @hash_opts = qw(header);
-my @exit_opts = qw(clean help ping debug);
+my @help_opts = qw(clean help ping);
+my @exit_opts = (@help_opts,@debug_opts);
my @request_opts = qw(get head post);
my %usage = (
- 'start-httpd' => 'start the test server',
- 'run-tests' => 'run the tests',
- 'times=N' => 'repeat the tests N times',
- 'order=mode' => 'run the tests in one of the modes: (repeat|rotate|random)',
- 'stop-httpd' => 'stop the test server',
- 'verbose' => 'verbose output',
- 'configure' => 'force regeneration of httpd.conf',
- 'clean' => 'remove all generated test files',
- 'help' => 'display this message',
- 'preamble' => 'config to add at the beginning of httpd.conf',
- 'postamble' => 'config to add at the end of httpd.conf',
- 'ping' => 'test if server is running or port in use',
- 'debug' => 'start server under debugger (e.g. gdb)',
- 'header' => "add headers to (".join('|', @request_opts).") request",
+ 'start-httpd' => 'start the test server',
+ 'run-tests' => 'run the tests',
+ 'times=N' => 'repeat the tests N times',
+ 'order=mode' => 'run the tests in one of the modes: (repeat|rotate|random)',
+ 'stop-httpd' => 'stop the test server',
+ 'verbose' => 'verbose output',
+ 'configure' => 'force regeneration of httpd.conf',
+ 'clean' => 'remove all generated test files',
+ 'help' => 'display this message',
+ 'preamble' => 'config to add at the beginning of httpd.conf',
+ 'postamble' => 'config to add at the end of httpd.conf',
+ 'ping' => 'test if server is running or port in use',
+ 'debug[=name]' => 'start server under debugger name (e.g. gdb, ddd, ...)',
+ 'breakpoint=bp' => 'set breakpoints (multiply bp can be set)',
+ 'header' => "add headers to (".join('|', @request_opts).") request",
(map { $_, "\U$_\E url" } @request_opts),
);
@@ -119,8 +122,9 @@
local *ARGV = $self->{args};
my(%opts, %vopts, %conf_opts);
- GetOptions(\%opts, @flag_opts, @exit_opts,
- (map "$_=s", @request_opts,@string_opts),
+ GetOptions(\%opts, @flag_opts, @help_opts,
+ (map "$_:s", @debug_opts),
+ (map "$_=s", @request_opts, @string_opts),
(map "$_=i", @num_opts),
(map { ("$_=s", $vopts{$_} ||= []) } @list_opts),
(map { ("$_=s", $vopts{$_} ||= {}) } @hash_opts));
@@ -136,6 +140,16 @@
$conf_opts{lc $key} = $val;
}
+ if (exists $opts{debug}) {
+ $opts{debugger} = $opts{debug};
+ $opts{debug} = 1;
+ }
+
+ # breakpoint automatically turns the debug mode on
+ if (@{ $opts{breakpoint} }) {
+ $opts{debug} ||= 1;
+ }
+
if ($opts{configure}) {
$conf_opts{save} = 1;
}
@@ -374,8 +388,14 @@
sub opt_debug {
my $self = shift;
my $server = $self->{server};
+
+ my $debug_opts = {};
+ for (qw(debugger breakpoint)) {
+ $debug_opts->{$_} = $self->{opts}->{$_};
+ }
+
$server->stop;
- $server->start_debugger;
+ $server->start_debugger($debug_opts);
}
sub opt_help {
Index: Apache-Test/lib/Apache/TestServer.pm
===================================================================
RCS file: /home/cvs/modperl-2.0/Apache-Test/lib/Apache/TestServer.pm,v
retrieving revision 1.11
diff -u -r1.11 TestServer.pm
--- Apache-Test/lib/Apache/TestServer.pm 2001/07/17 15:30:38 1.11
+++ Apache-Test/lib/Apache/TestServer.pm 2001/07/19 16:28:57
@@ -9,6 +9,14 @@
use Apache::TestTrace;
use Apache::TestConfig ();
+# some debuggers use the same syntax as others, so we reuse the same
+# code by using the following mapping
+my %debuggers =
+ (
+ gdb => 'gdb',
+ ddd => 'gdb',
+ );
+
sub trace {
shift->{config}->trace(@_);
}
@@ -74,23 +82,59 @@
sub start_gdb {
my $self = shift;
+ my $opts = shift;
- my $config = $self->{config};
- my $args = $self->args;
+ my $debugger = $opts->{debugger};
+ my @breakpoints = @{ $opts->{breakpoint} || [] };
+ my $config = $self->{config};
+ my $args = $self->args;
my $one_process = $self->version_of(\%one_process);
my $file = catfile $config->{vars}->{serverroot}, '.gdb-test-start';
- my $fh = $config->genfile($file, 1);
- print $fh "run $one_process $args";
+ my $fh = $config->genfile($file, 1);
+
+ 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;
- system "gdb $config->{vars}->{httpd} -command $file";
+ my $command;
+ if ($debugger eq 'ddd') {
+ $command = qq{ddd --gdb --debugger "gdb -command $file"
+$config->{vars}->{httpd}};
+ } else {
+ $command = "gdb $config->{vars}->{httpd} -command $file";
+ }
+ debug $command;
+ system $command;
+
unlink $file;
}
sub start_debugger {
- shift->start_gdb; #XXX support dbx and others
+ my $self = shift;
+ my $opts = shift;
+
+ $opts->{debugger} ||= $ENV{MP_DEBUGGER} || 'gdb';
+
+ unless ($debuggers{ $opts->{debugger} }) {
+ error "$opts->{debugger} is not a supported debugger",
+ "These are the supported debuggers: ".
+ join ", ", sort keys %debuggers;
+ die("\n");
+ }
+
+ my $method = "start_".$debuggers{ $opts->{debugger} };
+ $self->$method($opts);
}
sub pid {
_____________________________________________________________________
Stas Bekman JAm_pH -- Just Another mod_perl Hacker
http://stason.org/ mod_perl Guide http://perl.apache.org/guide
mailto:[EMAIL PROTECTED] http://apachetoday.com http://eXtropia.com/
http://singlesheaven.com http://perl.apache.org http://perlmonth.com/
---------------------------------------------------------------------
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
