Perl threads sometimes get stuck (some of them waiting for futex) - multithreading

Question

I'm facing a problem with a multi-threaded Perl application that I'm trying to run (on Redhat 7.4 using Perl 5.10.1). The problem has been reproduced through the setup below (setup is similar to the original Perl application):
There are 2 files: main.pl, module1.pm.
main.pl:
The top level script to complete a set of tasks, invoked as "main.pl <NumberOfTestsToRun> <MaxWorkersToUse>"
# main.pl
#!/apps/perl/5.10.1/bin/perl
use strict;
use warnings;
use v5.10.1;
use threads;
use threads::shared;
use module1;
use lib "<path to Thread::Queue module>";
use Thread::Queue;
my $glNumTests = shift(); # Number of tests(jobs) to run
my $glMaxThreads = shift(); # What is the max allowed number of workers (threads) for queue mode
my $q = Thread::Queue->new(); # A new empty queue
# Worker thread
sub worker
{
# Thread will loop until no more work
while (defined(my $item = $q->dequeue())) {
# Do work on $item
sleep(5); # dummy pre-work
$item->dummy(); # Actual task that needs to be run by each thread
}
}
sub start_threads
{
my $loNumThreads = shift();
$loNumThreads = $loNumThreads > $glMaxThreads ? $glMaxThreads : $loNumThreads;
print "Creating $loNumThreads threads...";
for ( 1..$loNumThreads )
{
threads->create(\&worker);
}
print "done\n";
}
sub initialize
{
my #lotests;
my $loNumTests = shift();
for my $i (1..$loNumTests)
{
push(#lotests,"Test_".$i);
}
return \#lotests;
}
sub launchjobs
{
my #lotests = #{shift()};
my $tests = {};
# Create objects
foreach my $lotest (#lotests)
{
$tests->{$lotest}->{"obj"} = module1->new($lotest);
}
# Start the threads before adding work to the queue
start_threads(scalar(#lotests));
# Adding work to queue
foreach my $lotest (#lotests)
{
$q->enqueue($tests->{$lotest}->{"obj"});
}
# No more work to be added
$q->end();
# Wait for threads to finish
foreach my $thr ( threads -> list() )
{
$thr->join();
}
}
launchjobs(initialize($glNumTests));
module1.pm:
Support module which runs another command(echo in this case) using the IPC::Run module
# module1.pm
package module1;
use lib "<InstallationPath>/IPC-Run-20200505.0/lib";
use IPC::Run qw( run );
sub new
{
my $class = shift();
my $test = shift();
my $self = {};
$self->{"testName"} = $test;
system("\\mkdir -p test_output/$self->{testName}");
# Create new file track.log for this object
open(my $OFH,">","test_output/$self->{testName}/track.log") || die "Cannot open track.log for writing in new\n";
close($OFH);
bless($self,$class);
return $self;
}
sub logTracker
{
# Writes out the message to track.log file
my $self = shift();
my $message = shift();
open(my $OFH,">>","test_output/$self->{testName}/track.log") || die"Cannot open track.log for writing\n";
print $OFH $message;
close($OFH);
}
sub dummy
{
my $self = shift();
print "running $self->{testName}\n";
my $loCmd = "echo"; # Command to be run
my $loArgs = "This is test $self->{testName}"; # Arguments to the above command
$self->logTracker("Calling run\n");
run [$loCmd,$loArgs],'>&',"test_output/$self->{testName}/output";
$self->logTracker("run completed\n");
}
1;
The output directory structure is as below:
<pwd>/test_output/Test_<TestNumber>/
and has two files - track.log and output in each Test_<TestNumber> directory
The problem I'm facing is that sometimes some of the threads get stuck at the IPC::run command (track.log file doesn't contain the "run completed" line).
For instance, When I last did "main.pl 1000 128" (1000 tests using 128 workers), many threads do not complete and main.pl keeps running (waiting). When I ran strace, I got the following output:
strace: Process 41187 attached with 8 threads
[pid 42343] read(22, <unfinished ...>
[pid 42292] read(20, <unfinished ...>
[pid 42291] read(25, <unfinished ...>
[pid 42282] read(24, <unfinished ...>
[pid 42234] read(43, <unfinished ...>
[pid 42212] read(18, <unfinished ...>
[pid 41187] futex(0x7ff2597939d0, FUTEX_WAIT, 42212, NULL <unfinished ...>
[pid 42338] read(16,
The process tree for the above run is as shown(once all the other threads have completed):
-perl,41187 main.pl 1000 128
|-perl,42614 main.pl 1000 128
|-perl,42615 main.pl 1000 128
|-perl,42616 main.pl 1000 128
|-perl,42617 main.pl 1000 128
|-perl,42618 main.pl 1000 128
|-perl,42620 main.pl 1000 128
|-perl,42621 main.pl 1000 128
|-{perl},42212
|-{perl},42234
|-{perl},42282
|-{perl},42291
|-{perl},42292
|-{perl},42338
`-{perl},42343
I'm not able to understand why this is happening (probably has to do with Threads::Queue or pipes etc.) It would be really great if someone could help me with this. I finally want to be able to run all the tests without any futex wait/hang problems. I have tried :
Using the timeout option of IPC::Run to check if the control returns but no luck here.
Using open3() instead of IPC::Run :- problem still exists and occurs more frequently compared to IPC::Run
Note:
This problem doesn't occur when I use Perl 5.16.3. But I need to make the original application work using Perl 5.10.1, hence it would be great if someone could help me in understanding how to fix this issue :)
In module1::dummy(), if $loCmd is changed to "sleep" and $loArgs to (say) "10", then the problem doesn't appear (giving the impression that it might have something to do with pipes/IO buffers).
The number of threads that get stuck can vary with different runs and also sometimes all the threads complete without any issues (race conditions might be present).