[prev in list] [next in list] [prev in thread] [next in thread]
List: apache-modperl-cvs
Subject: cvs commit: modperl-2.0/Apache-Test/lib/Apache TestRun.pm TestServer.pm
From: sbekman () apache ! org
Date: 2001-07-20 1:48:11
[Download RAW message or body]
sbekman 01/07/19 18:48:11
Modified: pod modperl_dev.pod
Apache-Test/lib/Apache TestRun.pm TestServer.pm
Log:
--- 1 ---
one of the supported debuggers can be invoked via the -debug switch:
e.g.: run with the defaults: gdb
% ./t/TEST -debug
or use ddd:
% ./t/TEST -debug=ddd
Note that currently we tell 'ddd' to internally use 'gdb'.
--- 2 ---
--breakpoint : set as many breakpoint as needed by repeating the key
e.g:
% ./t/TEST -debug -breakpoint=modperl_cmd_switches \
-breakpoint=modperl_cmd_options
will set the 'modperl_cmd_switches' and 'modperl_cmd_options'
breakpoints and run the debugger. But first it'll set the
'ap_run_pre_config' breakpoint and run till there, since without it we
cannot set breakpoints in mod_perl code if it's loaded via DSO.
If you want to tell the debugger to jump to the start of the mod_perl
code you may run:
% ./t/TEST -debug -breakpoint=modperl_hook_init
In fact --breakpoint automatically turns on the debug mode, so you can
run:
% ./t/TEST -breakpoint=modperl_hook_init
Revision Changes Path
1.30 +32 -0 modperl-2.0/pod/modperl_dev.pod
Index: modperl_dev.pod
===================================================================
RCS file: /home/cvs/modperl-2.0/pod/modperl_dev.pod,v
retrieving revision 1.29
retrieving revision 1.30
diff -u -r1.29 -r1.30
--- modperl_dev.pod 2001/07/17 02:10:25 1.29
+++ modperl_dev.pod 2001/07/20 01:48:11 1.30
@@ -232,6 +232,38 @@
then the I<-debug> shell will have a (gdb) prompt, type 'where' for
stacktrace.
+You can change the default debugger by supplying the name of the
+debugger as an argument to I<-debug>. E.g. to run the server under
+C<ddd>:
+
+ % ./t/TEST -debug=ddd
+
+=head2 Advanced Debugging
+
+If you debug mod_perl internals you can set the breakpoints using the
+I<-breakpoint> option, which can be repeated as many times as
+needed. When you set at least one breakpoint, the server will start
+running till it meets the I<ap_run_pre_config> breakpoint. At this
+point we can set the breakpoint for the mod_perl code, something we
+cannot do earlier if mod_perl was built as DSO. For example:
+
+ % ./t/TEST -debug -breakpoint=modperl_cmd_switches \
+ -breakpoint=modperl_cmd_options
+
+will set the I<modperl_cmd_switches> and I<modperl_cmd_options>
+breakpoints and run the debugger.
+
+If you want to tell the debugger to jump to the start of the mod_perl
+code you may run:
+
+ % ./t/TEST -debug -breakpoint=modperl_hook_init
+
+In fact I<-breakpoint> automatically turns on the debug mode, so you
+can run:
+
+ % ./t/TEST -breakpoint=modperl_hook_init
+
+
=head2 Running Individual Tests
Run a single test:
1.11 +39 -19 modperl-2.0/Apache-Test/lib/Apache/TestRun.pm
Index: TestRun.pm
===================================================================
RCS file: /home/cvs/modperl-2.0/Apache-Test/lib/Apache/TestRun.pm,v
retrieving revision 1.10
retrieving revision 1.11
diff -u -r1.10 -r1.11
--- TestRun.pm 2001/06/27 06:21:24 1.10
+++ TestRun.pm 2001/07/20 01:48:11 1.11
@@ -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 {
1.12 +51 -6 modperl-2.0/Apache-Test/lib/Apache/TestServer.pm
Index: TestServer.pm
===================================================================
RCS file: /home/cvs/modperl-2.0/Apache-Test/lib/Apache/TestServer.pm,v
retrieving revision 1.11
retrieving revision 1.12
diff -u -r1.11 -r1.12
--- TestServer.pm 2001/07/17 15:30:38 1.11
+++ TestServer.pm 2001/07/20 01:48:11 1.12
@@ -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,60 @@
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;
+
+ 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";
+ }
- system "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 {
[prev in list] [next in list] [prev in thread] [next in thread]
Configure |
About |
News |
Add a list |
Sponsored by KoreLogic