9 use Test::More tests => (1 + $tests + 1) + 3 + 5 + 2 + 4;
11 BEGIN { delete $ENV{PERL_INDIRECT_PM_DISABLE} }
15 my %wrong = map { $_ => 1 } 2, 3, 5, 6, 7, 9;
18 my ($pkg, $file, $prefix) = @_;
19 $file = defined $file ? quotemeta $file : '\(eval \d+\)';
20 $prefix = defined $prefix ? quotemeta $prefix : 'warn:';
21 qr/^${prefix}Indirect call of method "new" on object "$pkg" at $file line \d+/;
25 my $code = do { local $/; <DATA> };
26 my (%res, $num, @left);
29 local $SIG{__WARN__} = sub {
31 my $w = join '', 'warn:', @_;
32 if ($w =~ /"P(\d+)"/ and not exists $res{$1}) {
35 push @left, "[$num] $w";
40 is $@, '', 'DATA compiled fine';
45 like $w, expect("P$_"), "$_ should warn";
47 is $w, undef, "$_ shouldn't warn";
51 is @left, 0, 'nothing left';
52 diag "Extraneous warnings:\n", @left if @left;
58 local $SIG{__WARN__} = sub { push @w, join '', 'warn:', @_ };
59 eval 'return; { no indirect "global" }; BEGIN { eval q[return; new XYZ] }';
61 is $@, '', 'eval test did not croak prematurely';
62 is @w, 1, 'eval test threw one warning';
63 diag join "\n", 'All warnings:', @w if @w > 1;
64 like $w[0], expect('XYZ'), 'eval test threw the correct warning';
70 local $SIG{__WARN__} = sub { push @w, join '', 'warn:', @_ };
71 eval 'return; { no indirect "global" }; use indirect::TestRequiredGlobal';
73 is $@, '', 'require test did not croak prematurely';
74 is @w, 3, 'require test threw three warnings';
75 diag join "\n", 'All warnings:', @w if @w > 3;
76 like $w[0], expect('ABC', 't/lib/indirect/TestRequiredGlobal.pm'),
77 'require test first warning is correct';
78 like $w[1], expect('DEF'), 'require test second warning is correct';
79 like $w[2], expect('GHI'), 'require test third warning is correct';
85 local $SIG{__WARN__} = sub { push @w, join '', 'warn:', @_ };
86 eval 'return; { no indirect qw<global fatal> }; new MNO';
88 like $@, expect('MNO', undef, ''), 'fatal test throw the correct exception';
89 is @w, 0, 'fatal test did not throw any warning';
90 diag join "\n", 'All warnings:', @w if @w;
96 my $hook = sub { push @h, join '', 'hook:', indirect::msg(@_) };
98 local $SIG{__WARN__} = sub { push @w, join '', 'warn:', @_ };
99 eval 'return; { no indirect hook => $hook, "global" }; new PQR';
101 is $@, '', 'hook test did not croak prematurely';
102 is @w, 0, 'hook test did not throw any warning';
103 diag join "\n", 'All warnings:', @w if @w;
104 is @h, 1, 'hook test hooked up three violations';
105 diag join "\n", 'All captured violations:', @h if @h > 1;
106 like $h[0], expect('PQR', undef, 'hook:'),
107 'hook test captured the correct error';
114 no indirect 'global';
138 eval { my $i = new P9 };