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 my $num;
  21 BEGIN { $num = 20; }
  22
  23 use Test::More tests => $num;
  24
  25 BEGIN {
  26  defined and diag "Using threads $_" for $threads::VERSION;
  27
  28  if (eval "use Time::HiRes; 1") {
  29   defined and diag "Using Time::HiRes $_" for $Time::HiRes::VERSION;
  30   *usleep = \&Time::HiRes::usleep;
  31  } else {
  32   diag 'Using fallback usleep';
  33   *usleep = sub {
  34    my $s = int($_[0] / 2.5e5);
  35    sleep $s if $s;
  36   };
  37  }
  38 }
  39
  40 use Scope::Upper qw/unwind UP/;
  41
  42 our $z;
  43
  44 BEGIN {
  45 }
  46
  47 sub up1 {
  48  my $tid  = threads->tid();
  49  local $z = $tid;
  50  my $p    = "[$tid] up1";
  51
  52  usleep rand(1e6);
  53
  54  my @res = (
  55   -1,
  56   sub {
  57    my @dummy = (
  58     999,
  59     sub {
  60      my $foo = unwind $tid .. $tid + 2 => UP;
  61      fail "$p: not reached";
  62     }->()
  63    );
  64    fail "$p: not reached";
  65   }->(),
  66   -2
  67  );
  68
  69  is_deeply \@res, [ -1, $tid .. $tid + 2, -2 ], "$p: unwinded correctly";
  70 }
  71
  72 $_->join for map threads->create(\&up1), 1 .. $num;