t/59-unwind-threads.t

   1 #!perl -T
   2
   3 use strict;
   4 use warnings;
   5
   6 sub skipall {
   7  my ($msg) = @_;
   8  require Test::More;
   9  Test::More::plan(skip_all => $msg);
  10 }
  11
  12 use Config qw/%Config/;
  13
  14 BEGIN {
  15  skipall 'This perl wasn\'t built to support threads'
  16                                                     unless $Config{useithreads};
  17  skipall 'threads required to test thread safety' unless eval "use threads; 1";
  18 }
  19
  20 use Test::More;
  21
  22 use Scope::Upper qw/unwind UP SU_THREADSAFE/;
  23
  24 my $num;
  25
  26 BEGIN {
  27  skipall 'This Scope::Upper isn\'t thread safe' unless SU_THREADSAFE;
  28  plan tests => ($num = 30);
  29  defined and diag "Using threads $_" for $threads::VERSION;
  30  if (eval "use Time::HiRes; 1") {
  31   defined and diag "Using Time::HiRes $_" for $Time::HiRes::VERSION;
  32   *usleep = \&Time::HiRes::usleep;
  33  } else {
  34   diag 'Using fallback usleep';
  35   *usleep = sub {
  36    my $s = int($_[0] / 2.5e5);
  37    sleep $s if $s;
  38   };
  39  }
  40 }
  41
  42 our $z;
  43
  44 sub up1 {
  45  my $tid  = threads->tid();
  46  local $z = $tid;
  47  my $p    = "[$tid] up1";
  48
  49  usleep rand(1e6);
  50
  51  my @res = (
  52   -1,
  53   sub {
  54    my @dummy = (
  55     999,
  56     sub {
  57      my $foo = unwind $tid .. $tid + 2 => UP;
  58      fail "$p: not reached";
  59     }->()
  60    );
  61    fail "$p: not reached";
  62   }->(),
  63   -2
  64  );
  65
  66  is_deeply \@res, [ -1, $tid .. $tid + 2, -2 ], "$p: unwinded correctly";
  67 }
  68
  69 $_->join for map threads->create(\&up1), 1 .. $num;