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 threads support with no threads";
  22 $] > 5.008007
  23   or plan skip_all => "require a perl with CLONE_SKIP to test Imager's 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