#!perl -T

use strict;
use warnings;

use Config qw/%Config/;

BEGIN {
 if (!$Config{useithreads}) {
  require Test::More;
  Test::More->import;
  plan(skip_all => 'This perl wasn\'t built to support threads');
 }
}

use threads;

use Test::More;

BEGIN {
 require indirect;
 if (indirect::I_THREADSAFE()) {
  plan tests => 10 * 2 * (2 + 3);
  defined and diag "Using threads $_" for $threads::VERSION;
 } else {
  plan skip_all => 'This indirect isn\'t thread safe';
 }
}

sub expect {
 my ($pkg) = @_;
 return qr/^Indirect\s+call\s+of\s+method\s+"new"\s+on\s+object\s+"$pkg"\s+at\s+\(eval\s+\d+\)\s+line\s+\d+/;
}

{
 no indirect;

 sub try {
  my $tid = threads->tid();

  for (1 .. 2) {
   {
    my $class = "Coconut$tid";
    my @warns;
    {
     local $SIG{__WARN__} = sub { push @warns, "@_" };
     eval 'die "the code compiled but it shouldn\'t have\n";
           no indirect ":fatal"; my $x = new ' . $class . ' 1, 2;';
    }
    like         $@ || '', expect($class),
                      "\"no indirect\" in eval in thread $tid died as expected";
    is_deeply \@warns, [ ],
                      "\"no indirect\" in eval in thread $tid didn't warn";
   }

SKIP:
   {
    skip 'Hints aren\'t propagated into eval STRING below perl 5.10' => 3
                                                             unless $] >= 5.010;
    my $class = "Pineapple$tid";
    my @warns;
    {
     local $SIG{__WARN__} = sub { push @warns, "@_" };
     eval 'die "ok\n"; my $y = new ' . $class . ' 1, 2;';
    }
    is             $@, "ok\n",
    my $first = shift @warns;
    like $first || '', expect($class),
              "\"no indirect\" propagated into eval in thread $tid warned once";
    is_deeply \@warns, [ ],
         "\"no indirect\" propagated into eval in thread $tid warned just once";
   }
  }
 }
}

my @t = map threads->create(\&try), 1 .. 10;
$_->join for @t;
