From: Graham Knop <haarg@haarg.org>
Date: Sat, 22 Feb 2014 18:27:35 +0000 (-0500)
Subject: cope better with broken threads
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=p5sagit%2FDevel-GlobalDestruction.git;a=commitdiff_plain;h=1035e7c43d0f1fad25e611d33e65db671a787501

cope better with broken threads
---

diff --git a/t/02_thread.t b/t/02_thread.t
index 4a7b6d0..c5c4afe 100644
--- 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
--- 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
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;