1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
|
#!perl -T
package NotEmpty;
sub new;
package main;
use strict;
use warnings;
use Test::More tests => 3 * 9;
BEGIN { delete $ENV{PERL_INDIRECT_PM_DISABLE} }
sub meh;
my @warns;
sub try {
my ($code) = @_;
@warns = ();
{
local $SIG{__WARN__} = sub { push @warns, @_ };
eval $code;
}
}
{
local $/ = "####";
while (<DATA>) {
chomp;
s/\s*$//;
s/(.*?)$//m;
my ($skip, $prefix) = split /#+/, $1;
$skip = 0 unless defined $skip;
$prefix = '' unless defined $prefix;
s/\s*//;
SKIP:
{
skip "$_: $skip" => 9 if do { local $@; eval $skip };
{
local $_ = $_;
s/Pkg/Empty/g;
try "return; $prefix; use indirect; $_";
is $@, '', "use indirect: $_";
is @warns, 0, 'correct number of reports';
try "return; $prefix; no indirect; $_";
is $@, '', "no indirect: $_";
is @warns, 0, 'correct number of reports';
}
{
local $_ = $_;
s/Pkg/NotEmpty/g;
try "return; $prefix; use indirect; $_";
is $@, '', "use indirect, defined: $_";
is @warns, 0, 'correct number of reports';
try "return; $prefix; no indirect; $_";
is $@, '', "use indirect, defined: $_";
is @warns, 1, 'correct number of reports';
like $warns[0], qr/^Indirect call of method "meh" on object "NotEmpty" at \(eval \d+\) line \d+/, 'report 0 is correct';
}
}
}
}
__DATA__
meh Pkg->new;
####
meh Pkg->new();
####
meh Pkg->new, "Wut";
|
