perl-modperl-cvs mailing list archives

Site index · List index
Message view « Date » · « Thread »
Top « Date » · « Thread »
From sbek...@apache.org
Subject cvs commit: modperl-2.0/Apache-Test/lib/Apache TestRun.pm TestServer.pm
Date Fri, 20 Jul 2001 01:48:11 GMT
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 {
  
  
  

Mime
View raw message