f5e0a19f82072e86a105ee7c7b98c432b9515cd0
[perl.git] / ext / threads / t / err.t
1 use strict;
2 use warnings;
3
4 BEGIN {
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
15 use ExtUtils::testlib;
16
17 use_ok('threads');
18
19 ### Start of Testing ###
20
21 no warnings 'threads';
22
23 # Create a thread that generates an error
24 my $thr = threads->create(sub { my $x = Foo->new(); });
25
26 # Check that thread returns 'undef'
27 my $result = $thr->join();
28 ok(! defined($result), 'thread died');
29
30 # Check error
31 like($thr->error(), q/Can't locate object method/, '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
41 my $err = $thr->error();
42 ok(! defined($err), 'no error yet');
43
44 # Check that thread returns 'undef'
45 $result = $thr->join();
46 ok(! defined($result), 'thread died');
47
48 # Check that error object is retrieved
49 $err = $thr->error();
50 isa_ok($err, 'Err::Class', 'error object');
51 is($err->{error}, 'bogus', 'error field');
52
53 # Check that another thread can reference the error object
54 my $thrx = threads->create(sub { die(bless($thr->error(), 'Foo')); });
55
56 # Check that thread returns 'undef'
57 $result = $thrx->join();
58 ok(! defined($result), 'thread died');
59
60 # Check that the rethrown error object is retrieved
61 $err = $thrx->error();
62 isa_ok($err, 'Foo', 'error object');
63 is($err->{error}, 'bogus', 'error field');
64
65 exit(0);
66
67 # EOF