From: Vincent Pit <vince@profvince.com>
Date: Sun, 1 Sep 2013 14:39:29 +0000 (+0200)
Subject: Skip threads tests unless perl version is 5.13.4 or greater
X-Git-Tag: v0.14~2
X-Git-Url: http://git.vpit.fr/?p=perl%2Fmodules%2FLinux-SysInfo.git;a=commitdiff_plain;h=bea1d11f74a387b85e2daa0a684466ed65d7ea71

Skip threads tests unless perl version is 5.13.4 or greater

There was a long standing bug in the handling of GV <-> CV double linkage
that could (and explicitely did with a poisonous perl) cause segfaults at
thread destruction. It got fixed by Dave in commit 803f274 which went in
5.13.3, but the fix was amended for 5.13.4 in commit 09aad8f. Since it's
not really fair for the user to not be able to install the module because
of this, we skip the threads tests unless perl is at least 5.13.4.
---

diff --git a/MANIFEST b/MANIFEST
index a23850c..ff91fcd 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -11,3 +11,5 @@ t/01-import.t
 t/10-standard.t
 t/20-extended.t
 t/30-threads.t
+t/lib/Linux/SysInfo/TestThreads.pm
+t/lib/VPIT/TestHelpers.pm
diff --git a/t/30-threads.t b/t/30-threads.t
index 690bd11..cd4c3a6 100644
--- a/t/30-threads.t
+++ b/t/30-threads.t
@@ -3,22 +3,10 @@
 use strict;
 use warnings;
 
-use Config qw<%Config>;
-
-BEGIN {
- my $has_threads = do {
-  local $@;
-  $Config{useithreads} and eval "use threads; 1";
- };
- # Load Test::More after threads
- require Test::More;
- Test::More->import;
- if ($has_threads) {
-  plan(tests => 4 * 10);
- } else {
-  plan(skip_all => 'This perl wasn\'t built to support threads');
- }
-}
+use lib 't/lib';
+use Linux::SysInfo::TestThreads;
+
+use Test::More 'no_plan';
 
 use Linux::SysInfo qw<sysinfo>;
 
@@ -40,5 +28,8 @@ sub try {
  }
 }
 
-my @t = map { threads->create(\&try, $_) } 1 .. 10;
-$_->join for @t;
+my @threads = map spawn(\&try, $_), 1 .. 10;
+
+$_->join for @threads;
+
+pass 'done';
diff --git a/t/lib/Linux/SysInfo/TestThreads.pm b/t/lib/Linux/SysInfo/TestThreads.pm
new file mode 100644
index 0000000..37a88c9
--- /dev/null
+++ b/t/lib/Linux/SysInfo/TestThreads.pm
@@ -0,0 +1,49 @@
+package Linux::SysInfo::TestThreads;
+
+use strict;
+use warnings;
+
+use Config qw<%Config>;
+
+use VPIT::TestHelpers;
+
+sub diag {
+ require Test::More;
+ Test::More::diag($_) for @_;
+}
+
+sub import {
+ shift;
+
+ my $force = $ENV{PERL_LINUX_SYSINFO_TEST_THREADS} ? 1 : !1;
+ skip_all 'This perl wasn\'t built to support threads'
+                                                    unless $Config{useithreads};
+ skip_all 'perl 5.13.4 required to test thread safety'
+                                             unless $force or "$]" >= 5.013_004;
+
+ load_or_skip_all('threads', $force ? '0' : '1.67', [ ]);
+
+ my %exports = (
+  spawn => \&spawn,
+ );
+
+ my $pkg = caller;
+ while (my ($name, $code) = each %exports) {
+  no strict 'refs';
+  *{$pkg.'::'.$name} = $code;
+ }
+}
+
+sub spawn {
+ local $@;
+ my @diag;
+ my $thread = eval {
+  local $SIG{__WARN__} = sub { push @diag, "Thread creation warning: @_" };
+  threads->create(@_);
+ };
+ push @diag, "Thread creation error: $@" if $@;
+ diag(@diag) if @diag;
+ return $thread ? $thread : ();
+}
+
+1;