xt/x60threadgrind.t

   1 #!perl -w
   2 use strict;
   3 use Imager;
   4 use Imager::Color::Float;
   5 use Imager::Fill;
   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 # https://rt.cpan.org/Ticket/Display.html?id=65812
  31 # https://github.com/schwern/test-more/issues/labels/Test-Builder2#issue/100
  32 $Test::More::VERSION =~ /^2\.00_/
  33   and plan skip_all => "threads are hosed in 2.00_06 and presumably all 2.00_*";
  34
  35 plan tests => 1;
  36
  37 Imager->preload;
  38
  39 ++$|;
  40
  41 {
  42   my @t;
  43   for (1 .. 10) {
  44     push @t, threads->create
  45       (
  46        sub {
  47          my ($which) = @_;
  48          my @im;
  49          print "# start $which\n";
  50          for (1 .. 1000) {
  51            push @im, Imager->new(xsize => 10, ysize => 10);
  52            $im[0]->box(fill => { solid => "#FF0000" });
  53            my $im = Imager->new(xsize => 10, ysize => 10, type => "paletted");
  54            $im->setpixel(x => 5, y => 5, color => "#808080");
  55          }
  56          print "# end $which\n";
  57        },
  58        $_
  59       );
  60   }
  61   $_->join for @t;
  62   pass("grind image creation");
  63 }