1use strict; 2use warnings; 3 4BEGIN { 5 require($ENV{PERL_CORE} ? '../../t/test.pl' : './t/test.pl'); 6 7 use Config; 8 if (! $Config{'useithreads'}) { 9 skip_all(q/Perl not compiled with 'useithreads'/); 10 } 11 12 plan(10); 13} 14 15use ExtUtils::testlib; 16 17use_ok('threads'); 18 19### Start of Testing ### 20 21no warnings 'threads'; 22 23# Create a thread that generates an error 24my $thr = threads->create(sub { my $x = Foo->new(); }); 25 26# Check that thread returns 'undef' 27my $result = $thr->join(); 28ok(! defined($result), 'thread died'); 29 30# Check error 31like($thr->error(), qr/^Can't locate object method/s, 'thread error'); 32 33 34# Create a thread that 'die's with an object 35$thr = threads->create(sub { 36 threads->yield(); 37 sleep(1); 38 die(bless({ error => 'bogus' }, 'Err::Class')); 39 }); 40 41my $err = $thr->error(); 42ok(! defined($err), 'no error yet'); 43 44# Check that thread returns 'undef' 45$result = $thr->join(); 46ok(! defined($result), 'thread died'); 47 48# Check that error object is retrieved 49$err = $thr->error(); 50isa_ok($err, 'Err::Class', 'error object'); 51is($err->{error}, 'bogus', 'error field'); 52 53# Check that another thread can reference the error object 54my $thrx = threads->create(sub { die(bless($thr->error(), 'Foo')); }); 55 56# Check that thread returns 'undef' 57$result = $thrx->join(); 58ok(! defined($result), 'thread died'); 59 60# Check that the rethrown error object is retrieved 61$err = $thrx->error(); 62isa_ok($err, 'Foo', 'error object'); 63is($err->{error}, 'bogus', 'error field'); 64 65exit(0); 66 67# EOF 68