t/81-threads-teardown.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  'run_perl',
  10 );
  11
  12 use Test::Leaner tests => 2;
  13
  14 SKIP: {
  15  my $status = run_perl <<' RUN';
  16   { package IntX; package IntY; package IntZ; }
  17   my ($code, @expected);
  18   sub cb {
  19    my $e = shift(@expected) || q{DUMMY};
  20    --$code if $_[0] eq $e;
  21    ()
  22   }
  23   use threads;
  24   $code = threads->create(sub {
  25    $code = @expected = qw<IntX>;
  26    eval q{use Lexical::Types as => \&cb; my IntX $x;}; die if $@;
  27    return $code;
  28   })->join;
  29   $code += @expected = qw<IntZ>;
  30   eval q{my IntY $y;}; die if $@;
  31   eval q{use Lexical::Types as => \&cb; my IntZ $z;}; die if $@;
  32   $code += 256 if $code < 0;
  33   exit $code;
  34  RUN
  35  skip RUN_PERL_FAILED() => 1 unless defined $status;
  36  is $status, 0, 'loading the pragma in a thread and using it outside doesn\'t segfault';
  37 }
  38
  39 SKIP: {
  40  my $status = run_perl <<' RUN';
  41   use threads;
  42   BEGIN { require Lexical::Types; }
  43   sub X::DESTROY {
  44    my $res = eval 'use Lexical::Types; sub Z::TYPEDSCALAR { 123 } my Z $z';
  45    exit 1 if $@;
  46    exit 2 if not defined $res or $res != 123;
  47   }
  48   threads->create(sub {
  49    my $x = bless { }, 'X';
  50    $x->{self} = $x;
  51    return;
  52   })->join;
  53   exit 0;
  54  RUN
  55  skip RUN_PERL_FAILED() => 1 unless defined $status;
  56  is $status, 0, 'Lexical::Types can be loaded in eval STRING during global destruction at the end of a thread';
  57 }