From: Vincent Pit Date: Thu, 19 Mar 2015 19:25:32 +0000 (-0300) Subject: Update VPIT::TestHelpers to 6cd68168 X-Git-Tag: v0.27~14 X-Git-Url: http://git.vpit.fr/?p=perl%2Fmodules%2FScope-Upper.git;a=commitdiff_plain;h=1958b3c51f5a5e55822bc1ce12487535a59e12f8;hp=c50db90df8e42e68dbec0a73acc5010cc951d19d 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 7004ef0..7cdb54d 100644 --- 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 5645767..5599938 100644 --- a/t/54-unwind-threads.t +++ b/t/54-unwind-threads.t @@ -3,13 +3,16 @@ use strict; use warnings; +use Scope::Upper qw; + 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; - our $z; sub up1 { diff --git a/t/59-yield-threads.t b/t/59-yield-threads.t index fbe054f..4d6d0b2 100644 --- a/t/59-yield-threads.t +++ b/t/59-yield-threads.t @@ -3,13 +3,16 @@ use strict; use warnings; +use Scope::Upper qw; + 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; - our $z; sub up1 { diff --git a/t/69-uplevel-threads.t b/t/69-uplevel-threads.t index 9af7b30..9b3c188 100644 --- a/t/69-uplevel-threads.t +++ b/t/69-uplevel-threads.t @@ -3,13 +3,16 @@ use strict; use warnings; +use Scope::Upper qw; + 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; - sub depth { my $depth = 0; while (1) { diff --git a/t/79-uid-threads.t b/t/79-uid-threads.t index 6f2b06d..8fe180d 100644 --- a/t/79-uid-threads.t +++ b/t/79-uid-threads.t @@ -3,13 +3,16 @@ use strict; use warnings; +use Scope::Upper qw; + 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; - 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 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; - -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 c147f80..6942420 100644 --- 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 {