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