httpd-test-dev mailing list archives

Site index · List index
Message view « Date » · « Thread »
Top « Date » · « Thread »
From Stas Bekman <s...@stason.org>
Subject Re: [patch] user defined debug script
Date Thu, 22 Nov 2001 09:43:19 GMT
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:stas@stason.org  http://ticketmaster.com http://apacheweek.com
http://singlesheaven.com http://perl.apache.org http://perlmonth.com/


Mime
View raw message