Randy Kobes wrote:

[...]


1. I've changed the warning in the "else" part of the "if kill(0, $pid)"
in stop() to simply say that the server has gone away, which is what
that would mean -- there is no Windows error to retrieve at that point.



That's true ... I have one suggestion: in this section ==================================================================== diff -ruN modperl-2.0.orig/Apache-Test/lib/Apache/TestServer.pm modperl-2.0/Apache-Test/lib/Apache/TestServer.pm --- modperl-2.0.orig/Apache-Test/lib/Apache/TestServer.pm 2003-10-10 05:05:56.000000000 +0100 +++ modperl-2.0/Apache-Test/lib/Apache/TestServer.pm 2003-10-15 10:41:23.647485900 +0100 @@ -12,6 +12,7 @@ use Apache::TestRequest ();

+    if (WIN32) {
+        require Win32::Process;
+        my $obj = $self->{config}->{win32obj};
+        if (my $pid = $obj ? $obj->GetProcessID : $self->pid) {
+            if (kill(0, $pid)) {
+                Win32::Process::KillProcess($pid, 0);
+                warning "server $self->{name} shutdown";
+            }
+            else {
+                warning "Could not shutdown $self->{name}: " .
+                    "server has gone away\n";
+            }
====================================================================
you use the word "shutdown" in the else{} block, which
Apache::TestSmoke would use to signal that the server
has shutdown:

  my $stopped_ok = ($log =~ /shutdown/) ? 1  : 0;
  unless ($stopped_ok) {
      error "Failed to stop server\n $log";
      exit 1;
  }

Do we want, within Apache::TestSmoke, to differentiate
between a true shutdown and an apparent condition of the
server going away? If it did go away, maybe just print out
a warning, rather than an "exit 1;"?

I tried your suggestion out, but found that I never actually got the "gone away" message in practice anyway! I always get a "server is not running" message instead.

The reason is that Apache::TestRun::try_exit_opts() pings the server first and only calls Apache::TestServer::stop() if the server is still running. So there's actually no point in the "else" case above at all, I think -- it'll never be reached.

I suppose we could have Apache::TestSmoke::run_test() look for the "server is not running" message, and have it just warn about it rather than error and exit, but there's nearly nothing else after that anyway so we don't gain much by not exiting. In fact, if the server is not running at the end of the smoke then something has obviously gone wrong, so I think putting out an error makes sense anway.

If you agree then the attached patch might actually be the final one. It's just a slight change over the previous one to remove that redundant "else" block.

- Steve
diff -ruN modperl-2.0.orig/Apache-Test/lib/Apache/TestServer.pm 
modperl-2.0/Apache-Test/lib/Apache/TestServer.pm
--- modperl-2.0.orig/Apache-Test/lib/Apache/TestServer.pm       2003-10-10 
05:05:56.000000000 +0100
+++ modperl-2.0/Apache-Test/lib/Apache/TestServer.pm    2003-10-15 17:17:34.663679600 
+0100
@@ -12,6 +12,7 @@
 use Apache::TestRequest ();
 
 use constant COLOR => Apache::TestConfig::COLOR;
+use constant WIN32 => Apache::TestConfig::WIN32;
 
 my $CTRL_M = COLOR ? "\r" : "\n";
 
@@ -313,19 +314,17 @@
     my $self = shift;
     my $aborted = shift;
 
-    if (Apache::TestConfig::WIN32) {
-        if ($self->{config}->{win32obj}) {
-            $self->{config}->{win32obj}->Kill(0);
-            warning "server $self->{name} shutdown";
-            return 1;
+    if (WIN32) {
+        require Win32::Process;
+        my $obj = $self->{config}->{win32obj};
+        if (my $pid = $obj ? $obj->GetProcessID : $self->pid) {
+            if (kill(0, $pid)) {
+                Win32::Process::KillProcess($pid, 0);
+                warning "server $self->{name} shutdown";
+            }
         }
-        else {
-            require Win32::Process;
-            my $pid = $self->pid;
-            Win32::Process::KillProcess($pid, 0);
-            warning "server $self->{name} shutdown";
-            return 1;
-       }
+        unlink $self->pid_file if (-f $self->pid_file);
+        return 1;
     }
 
     my $pid = 0;
@@ -415,7 +414,22 @@
 
 sub start {
     my $self = shift;
-    my $old_pid = $self->stop;
+    my $old_pid = 0;
+    if (WIN32) {
+        # Stale PID files (e.g. left behind from a previous test run
+        # that crashed) cannot be trusted on Windows because PID's are
+        # re-used too frequently, so just remove it. If there is an old
+        # server still running then the attempt to start a new one below
+        # will simply fail because the port will be unavailable.
+        if (-f $self->pid_file) {
+            warn "Removing old PID file -- " .
+                "Unclean shutdown of previous test run?\n";
+            unlink $self->pid_file;
+        }
+    }
+    else {
+        $old_pid = $self->stop;
+    }
     my $cmd = $self->start_cmd;
     my $config = $self->{config};
     my $vars = $config->{vars};
@@ -436,7 +450,7 @@
     print "$cmd\n";
     my $old_sig;
 
-    if (Apache::TestConfig::WIN32) {
+    if (WIN32) {
         #make sure only 1 process is started for win32
         #else Kill will only shutdown the parent
         my $one_process = $self->version_of(\%one_process);
@@ -450,7 +464,11 @@
                                "$cmd $one_process",
                                1,
                                Win32::Process::NORMAL_PRIORITY_CLASS(),
-                               '.') || die Win32::Process::ErrorReport();
+                               '.');
+        unless ($obj) {
+            die "Could not start the server: " .
+                Win32::FormatMessage(Win32::GetLastError());
+        }
         $config->{win32obj} = $obj;
     }
     else {
diff -ruN modperl-2.0.orig/Apache-Test/lib/Apache/TestSmoke.pm 
modperl-2.0/Apache-Test/lib/Apache/TestSmoke.pm
--- modperl-2.0.orig/Apache-Test/lib/Apache/TestSmoke.pm        2003-10-10 
05:05:56.000000000 +0100
+++ modperl-2.0/Apache-Test/lib/Apache/TestSmoke.pm     2003-10-15 17:17:55.163286000 
+0100
@@ -717,6 +717,7 @@
 }
 
 sub kill_proc {
+    return if Apache::TestConfig::WIN32;
     my($self) = @_;
 
     # a hack
@@ -724,8 +725,9 @@
     my $file = catfile $t_logs, "httpd.pid";
     return unless -f $file;
 
-    my $pid = `cat $file`;
-    chomp $pid;
+    my $fh = Symbol::gensym();
+    open $fh, $file or return;
+    chomp(my $pid = <$fh> || '');
     return unless $pid;
 
     kill SIGINT => $pid;

---------------------------------------------------------------------
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]

Reply via email to