t/30-threads.t

   1 #!perl -T
   2
   3 use strict;
   4 use warnings;
   5
   6 use Config qw/%Config/;
   7
   8 BEGIN {
   9  if (!$Config{useithreads}) {
  10   require Test::More;
  11   Test::More->import;
  12   plan(skip_all => 'This perl wasn\'t built to support threads');
  13  }
  14 }
  15
  16 use threads;
  17
  18 use Test::More;
  19
  20 BEGIN {
  21  require Lexical::Types;
  22  if (Lexical::Types::LT_THREADSAFE()) {
  23   plan tests => 10 * 2 * 3 * (1 + 2);
  24   defined and diag "Using threads $_" for $threads::VERSION;
  25  } else {
  26   plan skip_all => 'This Lexical::Types isn\'t thread safe';
  27  }
  28 }
  29
  30 {
  31  package Lexical::Types::Test::Tag;
  32
  33  sub TYPEDSCALAR {
  34   my $tid = threads->tid();
  35   my ($file, $line) = (caller(0))[1, 2];
  36   my $where = "at $file line $line in thread $tid";
  37   Test::More::is($_[0], __PACKAGE__, "base type is correct $where");
  38   Test::More::is($_[2], 'Tag', "original type is correct $where");
  39   $_[1] = $tid;
  40   ();
  41  }
  42 }
  43
  44 { package Tag; }
  45
  46 use Lexical::Types as => 'Lexical::Types::Test::';
  47
  48 sub try {
  49  my $tid = threads->tid();
  50
  51  for (1 .. 2) {
  52   my Tag $t;
  53   is $t, $tid, "typed lexical correctly initialized at run $_ in thread $tid";
  54
  55   eval <<'EVALD';
  56    use Lexical::Types as => "Lexical::Types::Test::";
  57    my Tag $t2;
  58    is $t2, $tid, "typed lexical correctly initialized in eval at run $_ in thread $tid";
  59 EVALD
  60   diag $@ if $@;
  61
  62 SKIP:
  63   {
  64    skip 'Hints aren\'t propagated into eval STRING below perl 5.10' => 3
  65                                                              unless $] >= 5.010;
  66    eval <<'EVALD';
  67     my Tag $t3;
  68     is $t3, $tid, "typed lexical correctly initialized in eval (propagated) at run $_ in thread $tid"
  69 EVALD
  70   }
  71  }
  72 }
  73
  74 my @t = map threads->create(\&try), 1 .. 10;
  75 $_->join for @t;