[Bps-public-commit] r15779 - Test-HTTP-Server-Simple/lib/Test/HTTP/Server

[clkao at bestpractical.com]

Author: clkao
Date: Fri Sep  5 08:45:42 2008
New Revision: 15779

Modified:
   Test-HTTP-Server-Simple/lib/Test/HTTP/Server/Simple.pm

Log:
If a test script has other reaper who handled the waitpid we are expecting,
don't fall into infinite loop.

Do a final check and die if there's hanging process, otherwise it should be
fine just exiting.


Modified: Test-HTTP-Server-Simple/lib/Test/HTTP/Server/Simple.pm
==============================================================================
--- Test-HTTP-Server-Simple/lib/Test/HTTP/Server/Simple.pm	(original)
+++ Test-HTTP-Server-Simple/lib/Test/HTTP/Server/Simple.pm	Fri Sep  5 08:45:42 2008
@@ -82,9 +82,15 @@
     }
     else {
         @CHILD_PIDS = grep {kill 0, $_} @CHILD_PIDS;
-        while (@CHILD_PIDS) {
+        if (@CHILD_PIDS) {
             kill 'USR1', @CHILD_PIDS;
-            local $SIG{ALRM} = sub {die};
+            local $SIG{ALRM} = sub {
+                use POSIX ":sys_wait_h";
+                my @last_chance = grep { waitpid($_, WNOHANG) == -1 }
+                    grep { kill 0, $_ } @CHILD_PIDS;
+                die 'uncleaned Test::HTTP::Server::Simple processes: '.join(',', at last_chance)
+                    if @last_chance;
+            };
             alarm(5);
             eval {
                 my $pid;
@@ -92,6 +98,7 @@
                   while $pid = wait and $pid > 0 and @CHILD_PIDS;
                 @CHILD_PIDS = () if $pid == -1;
             };
+            die $@ if $@;
             alarm(0);
         }
     }