eyepopslikeamosquito has asked for the wisdom of the Perl Monks concerning the following question:

The following program usually hangs for me when I run it on Windows. 

use strict;
use warnings;
use threads;

$|=1;

my $niter  = 10;
# Seems to mostly work with $nforks = 2 but usually fails with $nforks
+ = 3.
my $nforks = 3;
my $Cmd = 'invalid_command';

warn "start niter=$niter nforks=$nforks cmd='$Cmd'\n";

sub do_one_kid {
   my $kid = shift;
   warn "kid $kid pid=$$ run cmd='$Cmd'\n";
   for my $i (1..$niter) {
      my $out = `$Cmd 2>&1`;
      my $rc = $? >> 8;
      warn "$i: kid $kid pid=$$ rc=$rc\n";
   }
   warn "kid $kid pid=$$ exit\n";
   return 42;
}

my @kids = ();
for my $n (1..$nforks)
{
   warn "$n: forking\n";
   my $t = threads->new(\&do_one_kid, $n);
   warn "I am the parent\n";
   push(@kids, $t);
}

for my $t (@kids) {
   warn "parent waiting\n";
   my $rc = $t->join();
   warn "parent $$: thread exited rc=$rc\n";
}

warn "end main\n";

[download]

I've got a patch to win32.c to fix the hang nearly ready. However, before submitting it to P5P, I thought it would be best if I also included a test in the patch.

Though I can write a test based on the above program easily enough, this test will hang when it fails ... which is less than desirable.

Grovelling through the tests that come with Perl, I noticed that the fresh_perl_is() function in t/test.pl seems to be used for tests that crash perl. But what about tests that don't crash perl but may cause it to hang forever? Is there a recommended way to write these types of tests?

Update 21-sep-2006: This bug has now been fixed (change #28873) in the Perl core in file win32/win32.c. Related links:

Replies are listed 'Best First'.
Re: How to write a test for backticks threads hang
by BrowserUk (Patriarch) on Sep 15, 2006 at 10:14 UTC

    Why not use another thread to effect a timeout?

    Stick the code that is currently in the main thread into an async() block, have the real main wait for some specified number of seconds before dying.

    I've attempted to use is_running() to produce an indication that it was hung, but that will only work if you have jdhedden's cpan version. 

    use strict;
use warnings;
use threads;

$|=1;

my $niter  = 10;
# Seems to mostly work with $nforks = 2 but usually fails with $nforks
+ = 3.
my $nforks = 3;
my $Cmd = 'invalid_command';

warn "start niter=$niter nforks=$nforks cmd='$Cmd'\n";

sub do_one_kid {
   my $kid = shift;
   my $tid = threads->self->tid;
   warn "kid $kid (tid:$tid) pid=$$ run cmd='$Cmd'\n";
   for my $i (1..$niter) {
      my $out = `$Cmd 2>&1`;
      my $rc = $? >> 8;
      warn "$i: kid $kid pid=$$ rc=$rc\n";
   }
   warn "kid $kid pid=$$ exit\n";
   return 42;
}

my @kids = ();
for my $n (1..$nforks)
{
   warn "$n: forking\n";
   my $t = threads->new(\&do_one_kid, $n);
   warn "I am the parent\n";
   push(@kids, $t);
}

my $main = async {
    for my $t (@kids) {
        my $tid = $t->tid;
       warn "parent waiting for $tid\n";
       my $rc = $t->join();
       warn "parent $$: thread $tid exited rc=$rc\n";
    }
};


sleep 10;
warn "'main' thread still running (hung); aborting" if $main->is_runni
+ng();
warn "end main\n";

    [download]
    Examine what is said, not who speaks -- Silence betokens consent -- Love the truth but pardon error.
    Lingua non convalesco, consenesco et abolesco. -- Rule 1 has a caveat! -- Who broke the cabal?
    "Science is about questioning the status quo. Questioning authority".
    In the absence of evidence, opinion is indistinguishable from prejudice.
[reply]
[d/l]
[select]
      ...that will only work if you have jdhedden's cpan version.
      Just to be clear, the CPAN versions of the threads and threads::shared modules are the same as those found in the blead version of Perl. In other words, they are the lastest official versions. They are not my versions per se (i.e., they're not my own implementations). I'm just the maintainer (and a contributor).
      Remember: There's always one more bug.
[reply]

Back to Seekers of Perl Wisdom