Problem with ithreads

[Oleg Feotast]

Hi.

I have FreeBSD 4.9 and Perl 5.8.6 with useithreads=define installed.

I run my script (source in the and of the message) and it works OK for 15-30
minutes. After that it slows down and soon freezes. I put counter in while
loop of thread_do sub to count how many requests each thread do. Each thread
do 100-150 requests and then die. When I send INT signal after script
worked for 40 minutes I get message: "A thread exited while 4 threads were
running". I tried to put the body of loop into eval block but it didn't
worked.

Why thread die and how to fix solve problem? Please, help me.

P.S. Sorry for my English.


#!/usr/bin/perl
use strict;
use threads;
use threads::shared;
use LWP::UserAgent;
use HTTP::Request::Common;
use Thread::Queue;

$| = 1;

my $thread_num : shared = 0;
my $max_thread = 50;
my $exit = 0;
my $dump = 0;
my %tid : shared = ();
my $result_q = Thread::Queue->new();

$SIG{INT} = sub { $exit++ };

threads->new(\&test) for (1..$max_thread);

while (!$exit) {
    for (my $i = 0; $i < $result_q->pending(); $i++) {
        print $result_q->dequeue(), "\n";
    }

    if ($dump++ > 100000) {
        print "Dump\n";
        dump_tid(\%tid);
        $dump = 0;
    }
}

print "Done\n";

sub test
{
    threads->self->detach();
    my $tid = threads->self->tid();
    while (1) {
        my $ua = LWP::UserAgent->new(timeout => 3);
        my $res = $ua->request(HEAD 'http://smth.com/');
        $result_q->enqueue("$tid;" . $res->code() . ";" . $res->message() .
";");

        lock %tid;
        $tid{$tid}++;
    }
}


sub dump_tid
{
    my $tid = shift;

    open (DUMP, "> dump.txt");
    print DUMP "$_ = $tid->{$_}\n" foreach keys %$tid;
    close DUMP;
}