cope better with broken threads

diff --git a/t/02_thread.t b/t/02_thread.t
index 4a7b6d0..c5c4afe 100644 (file)
--- a/t/02_thread.t
+++ b/t/02_thread.t
@@ -1,17 +1,4 @@
-use Config;
-BEGIN {
-  unless ($Config{useithreads}) {
-    print "1..0 # SKIP your perl does not support ithreads\n";
-    exit 0;
-  }
-}
-
-BEGIN {
-  unless (eval { require threads }) {
-    print "1..0 # SKIP threads.pm not installed\n";
-    exit 0;
-  }
-}
+use t::threads_check;
 
 use threads;
 use threads::shared;

diff --git a/t/05_thread_clone.t b/t/05_thread_clone.t
index f2c939f..95b9b58 100644 (file)
--- a/t/05_thread_clone.t
+++ b/t/05_thread_clone.t
@@ -1,21 +1,7 @@
+use t::threads_check;
 use strict;
 use warnings;
 
-use Config;
-BEGIN {
-  unless ($Config{useithreads}) {
-    print "1..0 # SKIP your perl does not support ithreads\n";
-    exit 0;
-  }
-}
-
-BEGIN {
-  unless (eval { require threads }) {
-    print "1..0 # SKIP threads.pm not installed\n";
-    exit 0;
-  }
-}
-
 BEGIN {
   if ($ENV{DEVEL_GLOBALDESTRUCTION_PP_TEST}) {
     unshift @INC, sub {

diff --git a/t/threads_check.pm b/t/threads_check.pm
new file mode 100644 (file)
index 0000000..176258b
--- /dev/null
+++ b/t/threads_check.pm
@@ -0,0 +1,32 @@
+package t::threads_check;
+
+sub _skip {
+  print "1..0 # SKIP $_[0]\n";
+  exit 0;
+}
+
+sub import {
+  my ($class, $op) = @_;
+  if ($0 eq '-' && $op) {
+    if ($op eq 'installed') {
+      eval { require threads } or exit 1;
+    }
+    elsif ($op eq 'create') {
+      require threads;
+      threads->create(sub{ 1 })->join;
+    }
+    exit 0;
+  }
+  require Config;
+  if (! $Config::Config{useithreads}) {
+    _skip "your perl does not support ithreads";
+  }
+  elsif (system "$^X", '-Mt::threads_check=installed') {
+    _skip "threads.pm not installed";
+  }
+  elsif (system "$^X", '-Mt::threads_check=create') {
+    _skip "threads broken on this machine";
+  }
+}
+
+1;