]> git.imager.perl.org - imager.git/blobdiff - t/t99thread.t
prefer static first
[imager.git] / t / t99thread.t
index b9ddbecd1a53f83d577387d4933ba4ae2cdcc0dc..f03cd249ca9f29ed989218fe70f43af368afd446 100644 (file)
@@ -3,22 +3,45 @@ use strict;
 use Imager;
 use Imager::Color::Float;
 use Imager::Fill;
 use Imager;
 use Imager::Color::Float;
 use Imager::Fill;
-use threads;
 use Config;
 use Config;
+my $loaded_threads;
+BEGIN {
+  if ($Config{useithreads} && $] > 5.008007) {
+    $loaded_threads =
+      eval {
+       require threads;
+       threads->import;
+       1;
+      };
+  }
+}
 use Test::More;
 
 $Config{useithreads}
 use Test::More;
 
 $Config{useithreads}
-  or plan skip_all => "can't test Imager's lack of threads support with no threads";
+  or plan skip_all => "can't test Imager's threads support with no threads";
+$] > 5.008007
+  or plan skip_all => "require a perl with CLONE_SKIP to test Imager's threads support";
+$loaded_threads
+  or plan skip_all => "couldn't load threads";
+
+$INC{"Devel/Cover.pm"}
+  and plan skip_all => "threads and Devel::Cover don't get along";
+
+# https://rt.cpan.org/Ticket/Display.html?id=65812
+# https://github.com/schwern/test-more/issues/labels/Test-Builder2#issue/100
+$Test::More::VERSION =~ /^2\.00_/
+  and plan skip_all => "threads are hosed in 2.00_06 and presumably all 2.00_*";
 
 
-plan tests => 11;
+plan tests => 13;
 
 my $thread = threads->create(sub { 1; });
 ok($thread->join, "join first thread");
 
 
 my $thread = threads->create(sub { 1; });
 ok($thread->join, "join first thread");
 
-# these are all, or contain, XS allocated objects, if we don't
-# probably handle CLONE requests, or provide a CLONE_SKIP, we'll
-# probably see a double-free, one from the thread, and the other from
-# the main line of control.
+# these are all, or contain, XS allocated objects, if we don't handle
+# CLONE requests, or provide a CLONE_SKIP, we'll probably see a
+# double-free, one from the thread, and the other from the main line
+# of control.
+#
 # So make one of each
 
 my $im = Imager->new(xsize => 10, ysize => 10);
 # So make one of each
 
 my $im = Imager->new(xsize => 10, ysize => 10);
@@ -59,7 +82,10 @@ my $t2 = threads->create
   (
    sub {
      ok(!UNIVERSAL::isa($im->{IMG}, "Imager::ImgRaw"),
   (
    sub {
      ok(!UNIVERSAL::isa($im->{IMG}, "Imager::ImgRaw"),
-       "the low level image object should be undef");
+       "the low level image object should become unblessed");
+     ok(!$im->_valid_image, "image no longer considered valid");
+     is($im->errstr, "images do not cross threads",
+       "check error message");
      1;
    }
   );
      1;
    }
   );