The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!perl

BEGIN {
    use Config;
    if (! $Config{'useithreads'}) {
        print("1..0 # SKIP Perl not compiled with 'useithreads'\n");
        exit(0);
    }
}

#eval { require threads; use threads; $have_threads = 1; } if( 'define' eq $Config{usethreads} );
use threads;
use threads::variables::reap;
use Test::More;

INIT {
    # for debugging
    1;
}

#plan( skip_all => "Test 01-basic isn't reasonable without threads" ) unless $threads::threads;
plan( tests => 9 );

sub runThreads(@)
{
    my @threads = @_;
    foreach my $thr (@threads)
    {
	threads->create($thr);
    }
    do
    {
	threads->yield();
	foreach my $thr (threads->list(threads::joinable) )
	{
	    $thr->join();
	}
    } while( scalar( threads->list(threads::all) ) > 0 );
}

my $dbh2 = 6;
reap($dbh2);
my @ary2;
@ary2 = qw'Perl rocks';
reap(@ary2);
my %h2;
%h2 = ( Perl => 'rocks' );
reap(%h2);

runThreads( \&runThreadScalar, \&runThreadArray, \&runThreadHash );
++$dbh2;
is( $dbh2, 7, 'function scalar' );
is( join(' ', @ary2), 'Perl rocks', 'function array' );
is( join(' ', %h2), 'Perl rocks', 'function hash' );

sub runThreadScalar
{
    is( $dbh2, undef, 'new thread function scalar in ' . threads->tid() );
    $dbh2 = 4;
    threads->create( \&runThreadScalar, 1 ) unless( $_[0] );
}

sub runThreadArray
{
    is( join(' ', @ary2), '', 'new thread function array in ' . threads->tid() );
    @ary2 = qw'NetBSD rocks';
    threads->create( \&runThreadArray, 1 ) unless( $_[0] );
}

sub runThreadHash
{
    is( join(' ', %h2), '', 'new thread function hash in ' . threads->tid() );
    %h2 = ( NetBSD => 'rocks' );
    threads->create( \&runThreadHash, 1 ) unless( $_[0] );
}