The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
use strict;
use Config;
use Test::More;
$|++; # try to keep stdout and stderr in order on Win32

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

# If Win32, fork() is done with threads, so we need various things
if ( $^O eq 'MSWin32' ) {

    # don't run this at all under Devel::Cover
    if ( $ENV{HARNESS_PERL_SWITCHES} &&
         $ENV{HARNESS_PERL_SWITCHES} =~ /Devel::Cover/ ) {
        plan skip_all => "Devel::Cover not compatible with Win32 pseudo-fork";
    }
   
    # skip if threads not available for some reasons
    if ( ! $Config{useithreads} ) { 
        plan skip_all => "Win32 fork() support requires threads";
    }

    # skip if perl < 5.8
    if ( $] < 5.008 ) {
        plan skip_all => "Win32 fork() support requires perl 5.8";
    }

    # skip if Scalar::Util::weaken isn't available
    eval "use Scalar::Util 'weaken'";
    if( $@ =~ /\AWeak references are not implemented/ ) {
        plan skip_all => "Win32 fork() support requires Scalar::Util::weaken()";
    }
}

# Otherwise, we're going to run the tests.
plan 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 $child_pid = fork;
if ( ! $child_pid ) { # we're in the child
        is( $o->name, "Larry", "got right superclass object name in child");
        is( $p->name, "Harry", "got right subclass object name in child"); 
        is( $p->color, "brown", "got right subclass object name in child"); 
    exit;
}
waitpid $child_pid, 0;

# current Test::More object counter is off due to child
Test::More->builder->current_test( 10 );