5 if ($ENV{'PERL_CORE'}){
7 unshift @INC, '../lib';
10 require($ENV{PERL_CORE} ? "./test.pl" : "./t/test.pl");
13 if (! $Config{'useithreads'}) {
14 skip_all(q/Perl not compiled with 'useithreads'/);
20 use ExtUtils::testlib;
24 ### Start of Testing ###
26 no warnings 'threads';
28 # Create a thread that generates an error
29 my $thr = threads->create(sub { my $x = 5/0; });
31 # Check that thread returns 'undef'
32 my $result = $thr->join();
33 ok(! defined($result), 'thread died');
36 like($thr->error(), 'division by zero', 'thread error');
39 # Create a thread that 'die's with an object
40 $thr = threads->create(sub {
43 die(bless({ error => 'bogus' }, 'Err::Class'));
46 my $err = $thr->error();
47 ok(! defined($err), 'no error yet');
49 # Check that thread returns 'undef'
50 $result = $thr->join();
51 ok(! defined($result), 'thread died');
53 # Check that error object is retrieved
55 isa_ok($err, 'Err::Class', 'error object');
56 is($err->{error}, 'bogus', 'error field');
58 # Check that another thread can reference the error object
59 my $thrx = threads->create(sub { die(bless($thr->error(), 'Foo')); });
61 # Check that thread returns 'undef'
62 $result = $thrx->join();
63 ok(! defined($result), 'thread died');
65 # Check that the rethrown error object is retrieved
66 $err = $thrx->error();
67 isa_ok($err, 'Foo', 'error object');
68 is($err->{error}, 'bogus', 'error field');