Update VPIT::TestHelpers to 6cd68168

And port threads tests to its new interface. The new 'force threads test'
environment variable is PERL_FORCE_TEST_THREADS.

diff --git a/MANIFEST b/MANIFEST
index 7004ef047bff456d766be2b9197849891c244ad4..7cdb54d45a5be72f20dc478b5ff2f2d6cf03e3c2 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -63,6 +63,5 @@ t/85-stress-yield.t
 t/86-stress-uplevel.t
 t/87-stress-uid.t
 t/lib/Scope/Upper/TestGenerator.pm
-t/lib/Scope/Upper/TestThreads.pm
 t/lib/Test/Leaner.pm
 t/lib/VPIT/TestHelpers.pm

diff --git a/t/54-unwind-threads.t b/t/54-unwind-threads.t
index 56457670f74be22c6864d1814ab6346c36688ed9..559993823e2759160260b652b14f77bd36038f88 100644 (file)
--- a/t/54-unwind-threads.t
+++ b/t/54-unwind-threads.t
@@ -3,13 +3,16 @@
 use strict;
 use warnings;
 
+use Scope::Upper qw<unwind UP>;
+
 use lib 't/lib';
-use Scope::Upper::TestThreads;
+use VPIT::TestHelpers (
+ threads => [ 'Scope::Upper' => Scope::Upper::SU_THREADSAFE ],
+ 'usleep',
+);
 
 use Test::Leaner;
 
-use Scope::Upper qw<unwind UP>;
-
 our $z;
 
 sub up1 {

diff --git a/t/59-yield-threads.t b/t/59-yield-threads.t
index fbe054f73aa8d4b36ecbacfc5d004e3bd80ddcfa..4d6d0b244b2842cc08bc915ff84b93ca0c3345ad 100644 (file)
--- a/t/59-yield-threads.t
+++ b/t/59-yield-threads.t
@@ -3,13 +3,16 @@
 use strict;
 use warnings;
 
+use Scope::Upper qw<yield UP>;
+
 use lib 't/lib';
-use Scope::Upper::TestThreads;
+use VPIT::TestHelpers (
+ threads => [ 'Scope::Upper' => Scope::Upper::SU_THREADSAFE ],
+ 'usleep',
+);
 
 use Test::Leaner;
 
-use Scope::Upper qw<yield UP>;
-
 our $z;
 
 sub up1 {

diff --git a/t/69-uplevel-threads.t b/t/69-uplevel-threads.t
index 9af7b3075a0d66892c6dd3c3af0d4c44226c3728..9b3c188f89fa563b9f4fa7395d765e0c40eb4db5 100644 (file)
--- a/t/69-uplevel-threads.t
+++ b/t/69-uplevel-threads.t
@@ -3,13 +3,16 @@
 use strict;
 use warnings;
 
+use Scope::Upper qw<uplevel UP>;
+
 use lib 't/lib';
-use Scope::Upper::TestThreads;
+use VPIT::TestHelpers (
+ threads => [ 'Scope::Upper' => Scope::Upper::SU_THREADSAFE ],
+ 'usleep',
+);
 
 use Test::Leaner;
 
-use Scope::Upper qw<uplevel UP>;
-
 sub depth {
  my $depth = 0;
  while (1) {

diff --git a/t/79-uid-threads.t b/t/79-uid-threads.t
index 6f2b06d0b5519aa529aca12c4c652c93a0e910a4..8fe180deb2e29239de00d8ed5b8a0e2ae9ef53e6 100644 (file)
--- a/t/79-uid-threads.t
+++ b/t/79-uid-threads.t
@@ -3,13 +3,16 @@
 use strict;
 use warnings;
 
+use Scope::Upper qw<uid validate_uid UP HERE>;
+
 use lib 't/lib';
-use Scope::Upper::TestThreads;
+use VPIT::TestHelpers (
+ threads => [ 'Scope::Upper' => Scope::Upper::SU_THREADSAFE ],
+ 'usleep',
+);
 
 use Test::Leaner;
 
-use Scope::Upper qw<uid validate_uid UP HERE>;
-
 my $top = uid;
 
 sub cb {

diff --git a/t/lib/Scope/Upper/TestThreads.pm b/t/lib/Scope/Upper/TestThreads.pm
deleted file mode 100644 (file)
index 6bb179f..0000000
--- a/t/lib/Scope/Upper/TestThreads.pm
+++ /dev/null
@@ -1,68 +0,0 @@
-package Scope::Upper::TestThreads;
-
-use strict;
-use warnings;
-
-use Config qw<%Config>;
-
-use Scope::Upper qw<SU_THREADSAFE>;
-
-use VPIT::TestHelpers;
-
-sub diag {
- require Test::Leaner;
- Test::Leaner::diag(@_);
-}
-
-sub import {
- shift;
-
- skip_all 'This Scope::Upper isn\'t thread safe' unless SU_THREADSAFE;
-
- my $force = $ENV{PERL_SCOPE_UPPER_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 $usleep;
- if (do { local $@; eval { require Time::HiRes; 1 } }) {
-  defined and diag "Using Time::HiRes $_" for $Time::HiRes::VERSION;
-  $exports{usleep} = \&Time::HiRes::usleep;
- } else {
-  diag 'Using fallback usleep';
-  $exports{usleep} = sub {
-   my $s = int($_[0] / 2.5e5);
-   sleep $s if $s;
-  };
- }
-
- 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 $@;
- if (@diag) {
-  require Test::Leaner;
-  Test::Leaner::diag($_) for @diag;
- }
- return $thread ? $thread : ();
-}
-
-1;

diff --git a/t/lib/VPIT/TestHelpers.pm b/t/lib/VPIT/TestHelpers.pm
index c147f80a919756cbdfacfccb26bfbc866bcb6ddd..69424208854ff243a950e847f0ac921508733536 100644 (file)
--- a/t/lib/VPIT/TestHelpers.pm
+++ b/t/lib/VPIT/TestHelpers.pm
@@ -5,20 +5,56 @@ use warnings;
 
 use Config ();
 
-my %exports = (
+sub export_to_pkg {
+ my ($subs, $pkg) = @_;
+
+ while (my ($name, $code) = each %$subs) {
+  no strict 'refs';
+  *{$pkg.'::'.$name} = $code;
+ }
+
+ return 1;
+}
+
+my %default_exports = (
  load_or_skip     => \&load_or_skip,
  load_or_skip_all => \&load_or_skip_all,
  run_perl         => \&run_perl,
  skip_all         => \&skip_all,
 );
 
+my %features = (
+ threads => \&init_threads,
+ usleep  => \&init_usleep,
+);
+
 sub import {
- my $pkg = caller;
+ shift;
+ my @opts = @_;
 
- while (my ($name, $code) = each %exports) {
-  no strict 'refs';
-  *{$pkg.'::'.$name} = $code;
+ my %exports = %default_exports;
+
+ for (my $i = 0; $i <= $#opts; ++$i) {
+  my $feature = $opts[$i];
+  next unless defined $feature;
+
+  my $args;
+  if ($i < $#opts and defined $opts[$i+1] and ref $opts[$i+1] eq 'ARRAY') {
+   ++$i;
+   $args = $opts[$i];
+  } else {
+   $args = [ ];
+  }
+
+  my $handler = $features{$feature};
+  die "Unknown feature '$feature'" unless defined $handler;
+
+  my %syms = $handler->(@$args);
+
+  $exports{$_} = $syms{$_} for sort keys %syms;
  }
+
+ export_to_pkg \%exports => scalar caller;
 }
 
 my $test_sub = sub {
@@ -120,6 +156,64 @@ sub run_perl {
  system { $^X } $^X, '-T', map("-I$_", @INC), '-e', $code;
 }
 
+sub init_threads {
+ my ($pkg, $threadsafe, $force_var) = @_;
+
+ skip_all 'This perl wasn\'t built to support threads'
+                                            unless $Config::Config{useithreads};
+
+ $pkg = 'package' unless defined $pkg;
+ skip_all "This $pkg isn't thread safe" if defined $threadsafe and !$threadsafe;
+
+ $force_var = 'PERL_FORCE_TEST_THREADS' unless defined $force_var;
+ my $force  = $ENV{$force_var} ? 1 : !1;
+ skip_all 'perl 5.13.4 required to test thread safety'
+                                             unless $force or "$]" >= 5.013_004;
+
+ if (($INC{'Test/More.pm'} || $INC{'Test/Leaner.pm'}) && !$INC{'threads.pm'}) {
+  die 'Test::More/Test::Leaner was loaded too soon';
+ }
+
+ load_or_skip_all 'threads',         $force ? '0' : '1.67', [ ];
+ load_or_skip_all 'threads::shared', $force ? '0' : '1.14', [ ];
+
+ require Test::Leaner;
+
+ diag "Threads testing forced by \$ENV{$force_var}" if $force;
+
+ return spawn => \&spawn;
+}
+
+sub init_usleep {
+ my $usleep;
+
+ if (do { local $@; eval { require Time::HiRes; 1 } }) {
+  defined and diag "Using usleep() from Time::HiRes $_"
+                                                      for $Time::HiRes::VERSION;
+  $usleep = \&Time::HiRes::usleep;
+ } else {
+  diag 'Using fallback usleep()';
+  $usleep = sub {
+   my $s = int($_[0] / 2.5e5);
+   sleep $s if $s;
+  };
+ }
+
+ return usleep => $usleep;
+}
+
+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;
+ return $thread ? $thread : ();
+}
+
 package VPIT::TestHelpers::Guard;
 
 sub new {