Bug 101767

From Bugzilla Helper:
User-Agent: Mozilla/5.0 (X11; U; Linux i686; en-US; rv:1.4) Gecko/20030703

Description of problem:
I was doing some testing of perl iThreads (use threads;) with the rawhide
glibc/perl 5.8.1rc4 RPMs and couldn't get my test program to behave properly. 
Running it under LD_ASSUME_KERNEL=2.4.19 works, though.  I tried many
combinations of threads and none of them worked without the LD_ASSUME_KERNEL set.

This seems to be Rawhide glibc specific.  I also tested on Taroon (RHAS 3.0
beta1) and RedHat 7.3 with perl 5.8.0 with good results.  Installing
perl-5.8.1-90.rc.4 on Taroon also works.


Version-Release number of selected component (if applicable):
perl-5.8.1-90.rc4.0, glibc-2.3.2-68

How reproducible:
Always

Steps to Reproduce:
1. run script in Additional Information.


Actual Results:  tobeya@linuxws1: >./threads.pl
done creating class threads ...
still waiting for class My, My::Class's thread
still waiting for class My, My::Class's thread
still waiting for class My, My::Class's thread
still waiting for class My, My::Class's thread
still waiting for class My, My::Class's thread
still waiting for class My, My::Class's thread
still waiting for class My, My::Class's thread
still waiting for class My, My::Class's thread
still waiting for class My, My::Class's thread
...

Expected Results:  tobeya@linuxws1: >LD_ASSUME_KERNEL=2.4.19 ./threads.pl
tid 2 is returning 1
tid 3 is returning 1
done creating class threads ...
still waiting for class My, My::Class's thread
joining thread id 3
joining thread id 2
still waiting for class 's thread
trying to join thread id 1
Joiner thread exiting ...


Additional info:

#!/usr/bin/perl -w
$| = 1;
use strict;

use threads;
use threads::shared;
our %threads : shared;
our $running : shared = 1;

# --------------------------------------------------------------------------- #
# run a thread for joining other threads
async {
    sleep 1;
    while ($running != 0) {
        sleep 1;
        lock( %threads );
        foreach my $class ( keys(%threads) ) {
            next if ( !defined($threads{$class}) );
            print "joining thread id $threads{$class}\n";
            threads->object($threads{$class})->join();
            delete($threads{$class});
        }
    }
    print "Joiner thread exiting ...\n";
};

# --------------------------------------------------------------------------- #

foreach my $class ( ('My::Class', 'My') ) {
    # let go of the lock as soon as we're done with it by putting it in a block
    {
        lock( %threads );
        $threads{$class} = undef;
    }
    # call startup on each class to in it's own thread
    my $thr = threads->create( sub { $class->startup() } );
}

print "done creating class threads ...\n";

until ( keys(%threads) == 0 ) {
    sleep 1;
    print "still waiting for class ",join(', ',keys(%threads)),"'s thread\n";
}
$running = 0;

# join all other threads
foreach my $thr ( threads->list() ) {
    print "trying to join thread id ".$thr->tid()."\n";
    $thr->join();
}
    
exit 0;

# --------------------------------------------------------------------------- #

package My;
sub startup {
    my $type = shift;
    my $self = bless( {}, $type );
    print "tid ".threads->self->tid()." is returning 1\n";
    # store my tid in %threads so it can be joined now that I'm done
    {
        lock( %threads );
        $threads{ref($self)} = threads->self->tid();
    }
}

package My::Class;
use base qw( My );