The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
use strict;
use Config;

# keep stdout and stderr in order on Win32

BEGIN {
    $|=1; 
    my $oldfh = select(STDERR); $| = 1; select($oldfh);
}

# If running under threads, Test::More must load *after* threads.pm
# so load Test::More only if needed to bail out or only after loading
# threads.pm

BEGIN {
    # don't run without threads configured
    if ( ! $Config{useithreads} ) {
        require Test::More;
        Test::More::plan( skip_all => 
            "perl ithreads not available" );
    }
    
    # don't run for Perl prior to 5.8 (with CLONE) (even if
    # threads *are* configured)
    if( $] < 5.008005 ) {
        require Test::More;
        Test::More::plan( skip_all => 
            "thread support requires perl 5.8.5" );
    }

    # don't run without Scalar::Util::weaken()
    eval "use Scalar::Util 'weaken'";
    if( $@ =~ /\AWeak references are not implemented/ ) {
        require Test::More;
        Test::More::plan( skip_all =>
            "Scalar::Util::weaken() is required for thread-safety" );
    }

    # don't run this at all under Devel::Cover
    if ( $ENV{HARNESS_PERL_SWITCHES} &&
         $ENV{HARNESS_PERL_SWITCHES} =~ /Devel::Cover/ ) {
        require Test::More;
        Test::More::plan( skip_all => 
            "Devel::Cover not compatible with threads" );
    }
    
}

use threads;
use Test::More tests => 10;

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

my $class    = "t::Object::Animal";
my $subclass = "t::Object::Animal::Antelope";
my ($o, $p);

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

require_ok( $class );
require_ok( $subclass );

ok( ($o = $class->new()) && $o->isa($class),
    "Creating a $class object"
);

ok( ($p = $subclass->new()) && $p->isa($subclass),
    "Creating a $subclass object"
);


is( $o->name( "Larry" ), "Larry",
    "Setting a name for the superclass object in the parent"
);

is( $p->name( "Harry" ), "Harry",
    "Setting a name for the subclass object in the parent"
);

is( $p->color( "brown" ), "brown",
    "Setting a color for the subclass object in the parent"
);

my $thr = threads->new( 
    sub { 
        is( $o->name, "Larry", "got right superclass object name in thread");
        is( $p->name, "Harry", "got right subclass object name in thread"); 
        is( $p->color, "brown", "got right subclass object name in thread"); 
    } 
);

SKIP: {
    skip "Couldn't create a thread", 3
        unless defined $thr;
    $thr->join;
}