httpd-test-dev mailing list archives

Site index · List index
Message view « Date » · « Thread »
Top « Date » · « Thread »
From Stas Bekman <s...@stason.org>
Subject [patch] (was Re: perl-framework server startup)
Date Thu, 03 Jan 2002 12:40:15 GMT
On Thu, 3 Jan 2002, Stas Bekman wrote:

> Rodent of Unusual Size wrote:
>
> > Was this feedback useful, Stas?
>
> Yes, yes. I can reproduce the problem. The respawned shell to set the
> ulimit loses the return status. I'm looking into it. It's a nasty one.

OK, Ken, please try this patch. If it works for you please try it in
various possible failure situations so we can close this issue. Thanks.

this patch changes two "things":

1. uses exec() to call itself for setting ulimit (this solves the lost
status problem). Hope this is portable.

2. directs all exit() calls in PerlRun.pm into one place for two reasons.
- Enable easier debug in the future
- functions like server->stop don't return 0/1 but -1..N, so it helps to
handle the exit arguments properly.

in addition all exit() calls ends in exit_shell, to which you may want to
pass a real return status which can have quite a few values.

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.80
diff -u -r1.80 TestRun.pm
--- Apache-Test/lib/Apache/TestRun.pm	31 Dec 2001 09:09:43 -0000	1.80
+++ Apache-Test/lib/Apache/TestRun.pm	3 Jan 2002 12:27:49 -0000
@@ -17,6 +17,7 @@
 use Config;

 use constant STARTUP_TIMEOUT => 300; # secs (good for extreme debug cases)
+use subs qw(exit_shell exit_perl);

 my %core_files  = ();

@@ -137,7 +138,7 @@
     my @invalid_argv = @{ $self->{argv} };
     if (@invalid_argv) {
         error "unknown opts or test names: @invalid_argv";
-        exit;
+        exit_perl 0;
     }

 }
@@ -258,16 +259,17 @@
         return unless $_[0] =~ /^Failed/i; #dont catch Test::ok failures
         $server->stop(1) if $opts->{'start-httpd'};
         $server->failed_msg("error running tests");
+        exit_perl 0;
     };

     $SIG{INT} = sub {
         if ($caught_sig_int++) {
             warning "\ncaught SIGINT";
-            exit;
+            exit_perl 0;
         }
         warning "\nhalting tests";
         $server->stop if $opts->{'start-httpd'};
-        exit;
+        exit_perl 0;
     };

     #try to make sure we scan for core no matter what happens
@@ -383,17 +385,19 @@
     for (@exit_opts) {
         next unless exists $self->{opts}->{$_};
         my $method = "opt_$_";
-        exit if $self->$method();
+        exit_perl $self->$method();
     }

     if ($self->{opts}->{'stop-httpd'}) {
+        my $ok = 1;
         if ($self->{server}->ping) {
-            $self->{server}->stop;
+            $ok = $self->{server}->stop;
+            $ok = $ok < 0 ? 0 : 1; # adjust to 0/1 logic
         }
         else {
             warning "server $self->{server}->{name} is not running";
         }
-        exit;
+        exit_perl $ok ;
     }
 }

@@ -407,7 +411,7 @@
               ($test_config->{APXS} ?
                "an apxs other than $test_config->{APXS}" : "apxs").
                " or put either in your PATH";
-        exit 1;
+        exit_perl 0;
     }

     my $opts = $self->{opts};
@@ -427,7 +431,7 @@
     }

     if ($opts->{'start-httpd'}) {
-        exit 1 unless $server->start;
+        exit_perl 0 unless $server->start;
     }
     elsif ($opts->{'run-tests'}) {
         my $is_up = $server->ping
@@ -436,7 +440,7 @@
                 && $server->wait_till_is_up(STARTUP_TIMEOUT));
         unless ($is_up) {
             error "server is not ready yet, try again.";
-            exit;
+            exit_perl 0;
         }
     }
 }
@@ -464,7 +468,7 @@
 sub stop {
     my $self = shift;

-    $self->{server}->stop if $self->{opts}->{'stop-httpd'};
+    return $self->{server}->stop if $self->{opts}->{'stop-httpd'};
 }

 sub new_test_config {
@@ -491,13 +495,10 @@
     }
     close $sh;

-    open $sh, "|$binsh" or die;
-    my @cmd = ("ulimit -c unlimited\n",
-               "exec $0 @ARGV");
-    warning "setting ulimit to allow core files\n@cmd";
-    print $sh @cmd;
-    close $sh;
-    exit; #exec above will take over
+    my $command = "ulimit -c unlimited; $0 @ARGV";
+    warning "setting ulimit to allow core files\n$command";
+    exec $command;
+    die "exec $command has failed"; # shouldn't be reached
 }

 sub set_ulimit {
@@ -548,13 +549,13 @@
             warning "forcing Apache::TestConfig object save";
             $self->{test_config}->save;
             warning "run 't/TEST -clean' to clean up before continuing";
-            exit 1;
+            exit_perl 0;
         }
     }

     if ($self->{opts}->{configure}) {
         warning "reconfiguration done";
-        exit;
+        exit_perl 1;
     }

     $self->try_exit_opts;
@@ -770,5 +771,18 @@

 }

+# in idiomatic perl functions return 1 on success 0 on
+# failure. Shell expects the opposite behavior. So this function
+# reverses the status.
+sub exit_perl {
+    exit_shell $_[0] ? 0 : 1;
+}
+
+# expects shell's exit status values (0==success)
+sub exit_shell {
+#    require Carp;
+#    Carp::cluck('exiting');
+    CORE::exit $_[0];
+}

 1;

_____________________________________________________________________
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