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
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
|
#!./perl -w
BEGIN {
unshift @INC, 't';
push @INC, "../../t";
require Config;
if ( ( $Config::Config{'extensions'} !~ /\bB\b/ ) ) {
print "1..0 # Skip -- Perl configured without B module\n";
exit 0;
}
require 'test.pl';
}
use strict;
use warnings;
plan tests => 29;
# Runs a separate perl interpreter with the appropriate lint options
# turned on
sub runlint ($$$;$) {
my ( $opts, $prog, $result, $testname ) = @_;
my $res = runperl(
switches => ["-MO=Lint,$opts"],
prog => $prog,
stderr => 1,
);
$res =~ s/-e syntax OK\n$//;
local $::Level = $::Level + 1;
is( $res, $result, $testname || $opts );
}
runlint 'magic-diamond', 'while(<>){}', <<'RESULT';
Use of <> at -e line 1
RESULT
runlint 'magic-diamond', 'while(<ARGV>){}', <<'RESULT';
Use of <> at -e line 1
RESULT
runlint 'magic-diamond', 'while(<FOO>){}', <<'RESULT';
RESULT
runlint 'context', '$foo = @bar', <<'RESULT';
Implicit scalar context for array in scalar assignment at -e line 1
RESULT
runlint 'context', '$foo = length @bar', <<'RESULT';
Implicit scalar context for array in length at -e line 1
RESULT
runlint 'context', 'our @bar', '';
runlint 'context', 'exists $BAR{BAZ}', '';
runlint 'implicit-read', '/foo/', <<'RESULT';
Implicit match on $_ at -e line 1
RESULT
runlint 'implicit-read', 'grep /foo/, ()', '';
runlint 'implicit-read', 'grep { /foo/ } ()', '';
runlint 'implicit-write', 's/foo/bar/', <<'RESULT';
Implicit substitution on $_ at -e line 1
RESULT
runlint 'implicit-read', 'for ( @ARGV ) { 1 }',
<<'RESULT', 'implicit-read in foreach';
Implicit use of $_ in foreach at -e line 1
RESULT
runlint 'implicit-read', '1 for @ARGV', '', 'implicit-read in foreach';
runlint 'dollar-underscore', '$_ = 1', <<'RESULT';
Use of $_ at -e line 1
RESULT
runlint 'dollar-underscore', 'sub foo {}; foo( $_ ) for @A', '';
runlint 'dollar-underscore', 'sub foo {}; map { foo( $_ ) } @A', '';
runlint 'dollar-underscore', 'sub foo {}; grep { foo( $_ ) } @A', '';
runlint 'dollar-underscore', 'print',
<<'RESULT', 'dollar-underscore in print';
Use of $_ at -e line 1
RESULT
runlint 'private-names', 'sub A::_f{};A::_f()', <<'RESULT';
Illegal reference to private name '_f' at -e line 1
RESULT
runlint 'private-names', '$A::_x', <<'RESULT';
Illegal reference to private name '_x' at -e line 1
RESULT
runlint 'private-names', 'sub A::_f{};A->_f()', <<'RESULT',
Illegal reference to private method name '_f' at -e line 1
RESULT
'private-names (method)';
runlint 'undefined-subs', 'foo()', <<'RESULT';
Nonexistent subroutine 'foo' called at -e line 1
RESULT
runlint 'undefined-subs', 'foo();sub foo;', <<'RESULT';
Undefined subroutine 'foo' called at -e line 1
RESULT
runlint 'regexp-variables', 'print $&', <<'RESULT';
Use of regexp variable $& at -e line 1
RESULT
runlint 'regexp-variables', 's/./$&/', <<'RESULT';
Use of regexp variable $& at -e line 1
RESULT
runlint 'bare-subs', 'sub bare(){1};$x=bare', '';
runlint 'bare-subs', 'sub bare(){1}; $x=[bare=>0]; $x=$y{bare}', <<'RESULT';
Bare sub name 'bare' interpreted as string at -e line 1
Bare sub name 'bare' interpreted as string at -e line 1
RESULT
{
# Check for backwards-compatible plugin support. This was where
# preloaded mdoules would register themselves with B::Lint.
my $res = runperl(
switches => ["-MB::Lint"],
prog =>
'BEGIN{B::Lint->register_plugin(X=>[q[x]])};use O(qw[Lint x]);sub X::match{warn qq[X ok.\n]};dummy()',
stderr => 1,
);
like( $res, qr/X ok\./, 'Lint legacy plugin' );
}
{
# Check for Module::Plugin support
my $res = runperl(
switches => [ '-It/pluglib', '-MO=Lint,none' ],
prog => 1,
stderr => 1,
);
like( $res, qr/Module::Pluggable ok\./, 'Lint uses Module::Pluggable' );
}
|
