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 );