T1/t/t30thread.t

   1 #!perl -w
   2 use strict;
   3 use Imager;
   4
   5 use Config;
   6 my $loaded_threads;
   7 BEGIN {
   8   if ($Config{useithreads} && $] > 5.008007) {
   9     $loaded_threads =
  10       eval {
  11        require threads;
  12        threads->import;
  13        1;
  14       };
  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 => 8;
  36
  37 Imager->open_log(log => "testout/t30thread.log");
  38
  39 my $ft1 = Imager::Font->new(file => "fontfiles/dcr10.pfb", type => "t1");
  40 ok($ft1, "make a font");
  41 ok($ft1->_valid, "and it's valid");
  42 my $ft2;
  43
  44 my $thr = threads->create
  45   (
  46    sub {
  47      ok(!$ft1->_valid, "first font no longer valid");
  48      $ft2 = Imager::Font->new(file => "fontfiles/dcr10.pfb", type => "t1");
  49      ok($ft2, "make a new font in thread");
  50      ok($ft2->_valid, "and it's valid");
  51      1;
  52    },
  53   );
  54
  55 ok($thr->join, "join the thread");
  56 ok($ft1->_valid, "original font still valid in main thread");
  57 is($ft2, undef, "font created in thread shouldn't be set in main thread");
  58
  59 Imager->close_log();