#!perl

use strict;
use warnings;

my $tests;
BEGIN { $tests = 9 }

use Test::More tests => (1 + $tests + 1) + 3 + 5 + 2 + 4;

BEGIN { delete $ENV{PERL_INDIRECT_PM_DISABLE} }

use lib 't/lib';

my %wrong = map { $_ => 1 } 2, 3, 5, 6, 7, 9;

sub expect {
 my ($pkg, $file, $prefix) = @_;
 $file   = defined $file   ? quotemeta $file   : '\(eval \d+\)';
 $prefix = defined $prefix ? quotemeta $prefix : 'warn:';
 qr/^${prefix}Indirect call of method "new" on object "$pkg" at $file line \d+/;
}

{
 my $code = do { local $/; <DATA> };
 my (%res, $num, @left);

 {
  local $SIG{__WARN__} = sub {
   ++$num;
   my $w = join '', 'warn:', @_;
   if ($w =~ /"P(\d+)"/ and not exists $res{$1}) {
    $res{$1} = $w;
   } else {
    push @left, "[$num] $w";
   }
  };
  eval "return; $code";
 }
 is $@, '', 'DATA compiled fine';

 for (1 .. $tests) {
  my $w = $res{$_};
  if ($wrong{$_}) {
   like $w, expect("P$_"), "$_ should warn";
  } else {
   is   $w, undef,         "$_ shouldn't warn";
  }
 }

 is @left, 0, 'nothing left';
 diag "Extraneous warnings:\n", @left if @left;
}

{
 my @w;
 {
  local $SIG{__WARN__} = sub { push @w, join '', 'warn:', @_ };
  eval 'return; { no indirect "global" }; BEGIN { eval q[return; new XYZ] }';
 }
 is   $@, '', 'eval test did not croak prematurely';
 is   @w, 1,  'eval test threw one warning';
 diag join "\n", 'All warnings:', @w if @w > 1;
 like $w[0], expect('XYZ'), 'eval test threw the correct warning';
}

{
 my @w;
 {
  local $SIG{__WARN__} = sub { push @w, join '', 'warn:', @_ };
  eval 'return; { no indirect "global" }; use indirect::TestRequiredGlobal';
 }
 is   $@, '', 'require test did not croak prematurely';
 is   @w, 3,  'require test threw three warnings';
 diag join "\n", 'All warnings:', @w if @w > 3;
 like $w[0], expect('ABC', 't/lib/indirect/TestRequiredGlobal.pm'),
                            'require test first warning is correct';
 like $w[1], expect('DEF'), 'require test second warning is correct';
 like $w[2], expect('GHI'), 'require test third warning is correct';
}

{
 my @w;
 {
  local $SIG{__WARN__} = sub { push @w, join '', 'warn:', @_ };
  eval 'return; { no indirect qw<global fatal> }; new MNO';
 }
 like $@, expect('MNO', undef, ''), 'fatal test throw the correct exception';
 is   @w, 0,                        'fatal test did not throw any warning';
 diag join "\n", 'All warnings:', @w if @w;
}

{
 my @w;
 my @h;
 my $hook = sub { push @h, join '', 'hook:', indirect::msg(@_) };
 {
  local $SIG{__WARN__} = sub { push @w, join '', 'warn:', @_ };
  eval 'return; { no indirect hook => $hook, "global" }; new PQR';
 }
 is   $@, '', 'hook test did not croak prematurely';
 is   @w, 0,  'hook test did not throw any warning';
 diag join "\n", 'All warnings:', @w if @w;
 is   @h, 1,  'hook test hooked up three violations';
 diag join "\n", 'All captured violations:', @h if @h > 1;
 like $h[0], expect('PQR', undef, 'hook:'),
              'hook test captured the correct error';
}

__DATA__
my $a = new P1;

{
 no indirect 'global';
 my $b = new P2;
 {
  my $c = new P3;
 }
 {
  use indirect;
  my $d = new P4;
 }
 my $e = new P5;
}

my $f = new P6;

no indirect;

my $g = new P7;

use indirect;

my $h = new P8;

{
 no indirect;
 eval { my $i = new P9 };
}