t/900-util/040-limit.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 image file limits are localized to a thread
  33
  34 plan tests => 31;
  35
  36 Imager->open_log(log => "testout/t082limit.log");
  37
  38 ok(Imager->set_file_limits(width => 10, height => 10, bytes => 300),
  39    "set limits to 10, 10, 300");
  40
  41 ok(Imager->check_file_limits(width => 10, height => 10),
  42    "successful check limits in parent");
  43
  44 ok(!Imager->check_file_limits(width => 10, height => 10, sample_size => 2),
  45    "failed check limits in parent");
  46
  47 my @threads;
  48 for my $tid (1..5) {
  49   my $t1 = threads->create
  50     (
  51      sub {
  52        my $id = shift;
  53        my $dlimit = $tid * 5;
  54        my $blimit = $dlimit * $dlimit * 3;
  55        ok(Imager->set_file_limits(width => $dlimit, height => $dlimit,
  56                                   bytes => $blimit),
  57           "$tid: set limits to $dlimit x $dlimit, $blimit bytes");
  58        ok(Imager->check_file_limits(width => $dlimit, height => $dlimit),
  59           "$tid: successful check $dlimit x $dlimit");
  60        ok(!Imager->check_file_limits(width => $dlimit, height => $dlimit, sample_size => 2),
  61           "$tid: failed check $dlimit x $dlimit, ssize 2");
  62        is_deeply([ Imager->get_file_limits ], [ $dlimit, $dlimit, $blimit ],
  63                  "check limits are still $dlimit x $dlimit , $blimit bytes");
  64      },
  65      $tid
  66     );
  67   push @threads, [ $tid, $t1 ];
  68 }
  69
  70 for my $thread (@threads) {
  71   my ($id, $t1) = @$thread;
  72   ok($t1->join, "join child $id");
  73 }
  74
  75 ok(Imager->check_file_limits(width => 10, height => 10),
  76    "test we still pass");
  77 ok(!Imager->check_file_limits(width => 10, height => 10, sample_size => 2),
  78    "test we still fail");
  79 is_deeply([ Imager->get_file_limits ], [ 10, 10, 300 ],
  80           "check original main thread limits still set");