t/80-threads.t

   1 #!perl
   2
   3 use strict;
   4 use warnings;
   5
   6 use lib 't/lib';
   7 use VPIT::TestHelpers (
   8  threads => [ 'Lexical::Types' => 'Lexical::Types::LT_THREADSAFE()' ],
   9 );
  10
  11 use Test::Leaner;
  12
  13 my $threads = 10;
  14 my $runs    = 2;
  15
  16 {
  17  package Lexical::Types::Test::Tag;
  18
  19  sub TYPEDSCALAR {
  20   my $tid = threads->tid();
  21   my ($file, $line) = (caller(0))[1, 2];
  22   my $where = "at $file line $line in thread $tid";
  23   local $Test::Builder::Level = $Test::Builder::Level + 1;
  24   Test::Leaner::is($_[0], __PACKAGE__, "base type is correct $where");
  25   Test::Leaner::is($_[2], 'Tag', "original type is correct $where");
  26   $_[1] = $tid;
  27   ();
  28  }
  29 }
  30
  31 { package Tag; }
  32
  33 use Lexical::Types as => 'Lexical::Types::Test::';
  34
  35 sub try {
  36  my $tid = threads->tid();
  37
  38  for (1 .. $runs) {
  39   my Tag $t;
  40   is $t, $tid, "typed lexical correctly initialized at run $_ in thread $tid";
  41
  42   eval <<'EVALD';
  43    use Lexical::Types as => "Lexical::Types::Test::";
  44    my Tag $t2;
  45    is $t2, $tid, "typed lexical correctly initialized in eval at run $_ in thread $tid";
  46 EVALD
  47   diag $@ if $@;
  48
  49 SKIP:
  50   {
  51    skip 'Hints aren\'t propagated into eval STRING below perl 5.10' => 3
  52                                                            unless "$]" >= 5.010;
  53    eval <<'EVALD';
  54     my Tag $t3;
  55     is $t3, $tid, "typed lexical correctly initialized in eval (propagated) at run $_ in thread $tid"
  56 EVALD
  57   }
  58  }
  59 }
  60
  61 my @t = map spawn(\&try), 1 .. $threads;
  62
  63 $_->join for @t;
  64
  65 pass 'done';
  66
  67 done_testing;