11 perl -MO=Lint[,OPTIONS] foo.pl
15 The B::Lint module is equivalent to an extended version of the B<-w>
16 option of B<perl>. It is named after the program F<lint> which carries
17 out a similar process for C programs.
19 =head1 OPTIONS AND LINT CHECKS
21 Option words are separated by commas (not whitespace) and follow the
22 usual conventions of compiler backend options. Following any options
23 (indicated by a leading B<->) come lint check arguments. Each such
24 argument (apart from the special B<all> and B<none> options) is a
25 word representing one possible lint check (turning on that check) or
26 is B<no-foo> (turning off that check). Before processing the check
27 arguments, a standard list of checks is turned on. Later options
28 override earlier ones. Available options are:
34 Produces a warning whenever an array is used in an implicit scalar
35 context. For example, both of the lines
40 will elicit a warning. Using an explicit B<scalar()> silences the
45 =item B<implicit-read> and B<implicit-write>
47 These options produce a warning whenever an operation implicitly
48 reads or (respectively) writes to one of Perl's special variables.
49 For example, B<implicit-read> will warn about these:
53 and B<implicit-write> will warn about these:
57 Both B<implicit-read> and B<implicit-write> warn about this:
63 This option warns whenever a bareword is implicitly quoted, but is also
64 the name of a subroutine in the current package. Typical mistakes that it will
67 use constant foo => 'bar';
71 Neither of these will do what a naive user would expect.
73 =item B<dollar-underscore>
75 This option warns whenever C<$_> is used either explicitly anywhere or
76 as the implicit argument of a B<print> statement.
78 =item B<private-names>
80 This option warns on each use of any variable, subroutine or
81 method name that lives in a non-current package but begins with
82 an underscore ("_"). Warnings aren't issued for the special case
83 of the single character name "_" by itself (e.g. C<$_> and C<@_>).
85 =item B<undefined-subs>
87 This option warns whenever an undefined subroutine is invoked.
88 This option will only catch explicitly invoked subroutines such
89 as C<foo()> and not indirect invocations such as C<&$subref()>
90 or C<$obj-E<gt>meth()>. Note that some programs or modules delay
91 definition of subs until runtime by means of the AUTOLOAD
94 =item B<regexp-variables>
96 This option warns whenever one of the regexp variables C<$`>, C<$&> or C<$'>
97 is used. Any occurrence of any of these variables in your
98 program can slow your whole program down. See L<perlre> for
103 Turn all warnings on.
107 Turn all warnings off.
111 =head1 NON LINT-CHECK OPTIONS
117 Normally, Lint only checks the main code of the program together
118 with all subs defined in package main. The B<-u> option lets you
119 include other package names whose subs are then checked by Lint.
125 This is only a very preliminary version.
127 This module doesn't work correctly on thread-enabled perls.
131 Malcolm Beattie, mbeattie@sable.ox.ac.uk.
136 use B qw(walkoptree_slow main_root walksymtable svref_2object parents
137 OPf_WANT_LIST OPf_WANT OPf_STACKED G_ARRAY SVf_POK
140 my $file = "unknown"; # shadows current filename
141 my $line = 0; # shadows current line number
142 my $curstash = "main"; # shadows current stash
146 my %implies_ok_context;
148 map($implies_ok_context{$_}++,
149 qw(scalar av2arylen aelem aslice helem hslice
150 keys values hslice defined undef delete));
153 # Lint checks turned on by default
154 my @default_checks = qw(context);
159 map($valid_check{$_}++,
160 qw(context implicit_read implicit_write dollar_underscore
161 private_names bare_subs undefined_subs regexp_variables));
167 my %done_cv; # used to mark which subs have already been linted
168 my @extra_packages; # Lint checks mainline code and all subs which are
169 # in main:: or in one of these packages.
172 my $format = (@_ < 2) ? "%s" : shift;
173 warn sprintf("$format at %s line %d\n", @_, $file, $line);
176 # This gimme can't cope with context that's only determined
177 # at runtime via dowantarray().
180 my $flags = $op->flags;
181 if ($flags & OPf_WANT) {
182 return(($flags & OPf_WANT) == OPf_WANT_LIST ? 1 : 0);
191 if ($op->name eq "nextstate") {
194 $curstash = $op->stash->NAME;
200 my $opname = $op->name;
201 if ($check{context} && ($opname eq "rv2av" || $opname eq "rv2hv")) {
202 my $parent = parents->[0];
203 my $pname = $parent->name;
204 return if gimme($op) || $implies_ok_context{$pname};
205 # Two special cases to deal with: "foreach (@foo)" and "delete $a{$b}"
206 # null out the parent so we have to check for a parent of pp_null and
207 # a grandparent of pp_enteriter or pp_delete
208 if ($pname eq "null") {
209 my $gpname = parents->[1]->name;
210 return if $gpname eq "enteriter" || $gpname eq "delete";
212 warning("Implicit scalar context for %s in %s",
213 $opname eq "rv2av" ? "array" : "hash", $parent->desc);
215 if ($check{private_names} && $opname eq "method") {
216 my $methop = $op->first;
217 if ($methop->name eq "const") {
218 my $method = $methop->sv->PV;
219 if ($method =~ /^_/ && !defined(&{"$curstash\::$method"})) {
220 warning("Illegal reference to private method name $method");
228 if ($check{implicit_read}) {
229 if ($op->name eq "match" && !($op->flags & OPf_STACKED)) {
230 warning('Implicit match on $_');
233 if ($check{implicit_write}) {
234 if ($op->name eq "subst" && !($op->flags & OPf_STACKED)) {
235 warning('Implicit substitution on $_');
242 if ($check{implicit_read} || $check{implicit_write}) {
243 if ($op->name eq "enteriter") {
244 my $last = $op->last;
245 if ($last->name eq "gv" && $last->gv->NAME eq "_") {
246 warning('Implicit use of $_ in foreach');
254 if ( $check{bare_subs} && $op->name eq 'const'
255 && $op->private & 64 ) # OPpCONST_BARE = 64 in op.h
258 if( $sv->FLAGS & SVf_POK && exists &{$curstash.'::'.$sv->PV} ) {
259 warning "Bare sub name '" . $sv->PV . "' interpreted as string";
262 if ($check{dollar_underscore} && $op->name eq "gvsv"
263 && $op->gv->NAME eq "_")
265 warning('Use of $_');
267 if ($check{private_names}) {
268 my $opname = $op->name;
269 if ($opname eq "gv" || $opname eq "gvsv") {
271 if ($gv->NAME =~ /^_./ && $gv->STASH->NAME ne $curstash) {
272 warning('Illegal reference to private name %s', $gv->NAME);
274 } elsif ($opname eq "method_named") {
275 my $method = $op->gv->PV;
276 if ($method =~ /^_./) {
277 warning("Illegal reference to private method name $method");
281 if ($check{undefined_subs}) {
282 if ($op->name eq "gv"
283 && $op->next->name eq "entersub")
286 my $subname = $gv->STASH->NAME . "::" . $gv->NAME;
288 if (!defined(&$subname)) {
289 $subname =~ s/^main:://;
290 warning('Undefined subroutine %s called', $subname);
294 if ($check{regexp_variables} && $op->name eq "gvsv") {
295 my $name = $op->gv->NAME;
296 if ($name =~ /^[&'`]$/) {
297 warning('Use of regexp variable $%s', $name);
305 #warn sprintf("lintcv: %s::%s (done=%d)\n",
306 # $gv->STASH->NAME, $gv->NAME, $done_cv{$$cv});#debug
307 return if !$$cv || $done_cv{$$cv}++;
308 my $root = $cv->ROOT;
309 #warn " root = $root (0x$$root)\n";#debug
310 walkoptree_slow($root, "lint") if $$root;
315 walkoptree_slow(main_root, "lint") if ${main_root()};
317 # Now do subs in main
318 no strict qw(vars refs);
320 for my $sym (keys %main::) {
321 next if $sym =~ /::$/;
322 *glob = $main::{$sym};
323 svref_2object(\*glob)->EGV->lintcv;
326 # Now do subs in non-main packages given by -u options
327 map { $search_pack{$_} = 1 } @extra_packages;
328 walksymtable(\%{"main::"}, "lintcv", sub {
331 #warn "Considering $package\n";#debug
332 return exists $search_pack{$package};
338 my ($option, $opt, $arg);
339 # Turn on default lint checks
340 for $opt (@default_checks) {
344 while ($option = shift @options) {
345 if ($option =~ /^-(.)(.*)/) {
349 unshift @options, $option;
352 if ($opt eq "-" && $arg eq "-") {
355 } elsif ($opt eq "D") {
356 $arg ||= shift @options;
357 foreach $arg (split(//, $arg)) {
360 } elsif ($arg eq "O") {
364 } elsif ($opt eq "u") {
365 $arg ||= shift @options;
366 push(@extra_packages, $arg);
369 foreach $opt (@default_checks, @options) {
372 %check = %valid_check;
374 elsif ($opt eq "none") {
378 if ($opt =~ s/^no_//) {
384 warn "No such check: $opt\n" unless defined $valid_check{$opt};
387 # Remaining arguments are things to check