1 package Scope::Upper::TestThreads;
6 use Config qw<%Config>;
8 use Scope::Upper qw<SU_THREADSAFE>;
13 Test::Leaner::plan(skip_all => $msg);
18 Test::Leaner::diag(@_);
24 skipall 'This Scope::Upper isn\'t thread safe' unless SU_THREADSAFE;
26 my $force = $ENV{PERL_SCOPE_UPPER_TEST_THREADS} ? 1 : !1;
27 skipall 'This perl wasn\'t built to support threads'
28 unless $Config{useithreads};
29 skipall 'perl 5.13.4 required to test thread safety'
30 unless $force or "$]" >= 5.013_004;
32 my $t_v = $force ? '0' : '1.67';
33 my $has_threads = do {
35 eval "use threads $t_v; 1";
37 skipall "threads $t_v required to test thread safety" unless $has_threads;
39 defined and diag "Using threads $_" for $threads::VERSION;
41 my $has_time_hires = do {
43 eval { require Time::HiRes; 1 };
51 if ($has_time_hires) {
52 defined and diag "Using Time::HiRes $_" for $Time::HiRes::VERSION;
53 $exports{usleep} = \&Time::HiRes::usleep;
55 diag 'Using fallback usleep';
56 $exports{usleep} = sub {
57 my $s = int($_[0] / 2.5e5);
63 while (my ($name, $code) = each %exports) {
65 *{$pkg.'::'.$name} = $code;
73 local $SIG{__WARN__} = sub { push @diag, "Thread creation warning: @_" };
76 push @diag, "Thread creation error: $@" if $@;
79 Test::Leaner::diag($_) for @diag;
81 return $thread ? $thread : ();