tests for context handling of the error stack
[imager.git] / t / t081error.t
1 #!perl -w
2 use strict;
3
4 # avoiding this prologue would be nice, but it seems to be unavoidable,
5 # see "It is also important to note ..." in perldoc threads
6 use Config;
7 my $loaded_threads;
8 BEGIN {
9   if ($Config{useithreads} && $] > 5.008007) {
10     $loaded_threads =
11       eval {
12         require threads;
13         threads->import;
14         1;
15       };
16   }
17 }
18 use Test::More;
19
20 $Config{useithreads}
21   or plan skip_all => "can't test Imager's lack of threads support with no threads";
22 $] > 5.008007
23   or plan skip_all => "require a perl with CLONE_SKIP to test Imager's lack of threads support";
24 $loaded_threads
25   or plan skip_all => "couldn't load threads";
26
27 $INC{"Devel/Cover.pm"}
28   and plan skip_all => "threads and Devel::Cover don't get along";
29
30 use Imager;
31
32 # test that the error contexts are separate under threads
33
34 plan tests => 11;
35
36 Imager->open_log(log => "testout/t081error.log");
37
38 Imager::i_clear_error();
39 Imager::i_push_error(0, "main thread a");
40
41 my @threads;
42 for my $tid (1..5) {
43   my $t1 = threads->create
44     (
45      sub {
46        my $id = shift;
47        Imager::i_push_error(0, "$id: child thread a");
48        sleep(1+rand(4));
49        Imager::i_push_error(1, "$id: child thread b");
50
51        is_deeply([ Imager::i_errors() ],
52                  [
53                   [ "$id: child thread b", 1 ],
54                   [ "$id: child thread a", 0 ],
55                  ], "$id: check errors in child");
56        1;
57      },
58      $tid
59     );
60   push @threads, [ $tid, $t1 ];
61 }
62
63 Imager::i_push_error(1, "main thread b");
64
65 for my $thread (@threads) {
66   my ($id, $t1) = @$thread;
67   ok($t1->join, "join child $id");
68 }
69
70 Imager::i_push_error(2, "main thread c");
71
72 is_deeply([ Imager::i_errors() ],
73           [
74            [ "main thread c", 2 ],
75            [ "main thread b", 1 ],
76            [ "main thread a", 0 ],
77           ], "check errors in parent");
78