t/30-threads.t

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