[p5sagit/p5-mst-13.2.git] / ext / B / B / Lint.pm

package B::Lint;

our $VERSION = '1.02';

=head1 NAME

B::Lint - Perl lint

=head1 SYNOPSIS

perl -MO=Lint[,OPTIONS] foo.pl

=head1 DESCRIPTION

The B::Lint module is equivalent to an extended version of the B<-w>
option of B<perl>. It is named after the program B<lint> which carries
out a similar process for C programs.

=head1 OPTIONS AND LINT CHECKS

Option words are separated by commas (not whitespace) and follow the
usual conventions of compiler backend options. Following any options
(indicated by a leading B<->) come lint check arguments. Each such
argument (apart from the special B<all> and B<none> options) is a
word representing one possible lint check (turning on that check) or
is B<no-foo> (turning off that check). Before processing the check
arguments, a standard list of checks is turned on. Later options
override earlier ones. Available options are:

=over 8

=item B<context>

Produces a warning whenever an array is used in an implicit scalar
context. For example, both of the lines

    $foo = length(@bar);
    $foo = @bar;
will elicit a warning. Using an explicit B<scalar()> silences the
warning. For example,

    $foo = scalar(@bar);

=item B<implicit-read> and B<implicit-write>

These options produce a warning whenever an operation implicitly
reads or (respectively) writes to one of Perl's special variables.
For example, B<implicit-read> will warn about these:

    /foo/;

and B<implicit-write> will warn about these:

    s/foo/bar/;

Both B<implicit-read> and B<implicit-write> warn about this:

    for (@a) { ... }

=item B<bare-subs>

This option warns whenever a bareword is implicitly quoted, but is also
the name of a subroutine in the current package. Typical mistakes that it will
trap are:

	use constant foo => 'bar';
	@a = ( foo => 1 );
	$b{foo} = 2;

Neither of these will do what a naive user would expect.

=item B<dollar-underscore>

This option warns whenever $_ is used either explicitly anywhere or
as the implicit argument of a B<print> statement.

=item B<private-names>

This option warns on each use of any variable, subroutine or
method name that lives in a non-current package but begins with
an underscore ("_"). Warnings aren't issued for the special case
of the single character name "_" by itself (e.g. $_ and @_).

=item B<undefined-subs>

This option warns whenever an undefined subroutine is invoked.
This option will only catch explicitly invoked subroutines such
as C<foo()> and not indirect invocations such as C<&$subref()>
or C<$obj-E<gt>meth()>. Note that some programs or modules delay
definition of subs until runtime by means of the AUTOLOAD
mechanism.

=item B<regexp-variables>

This option warns whenever one of the regexp variables $', $& or
$' is used. Any occurrence of any of these variables in your
program can slow your whole program down. See L<perlre> for
details.

=item B<all>

Turn all warnings on.

=item B<none>

Turn all warnings off.

=back

=head1 NON LINT-CHECK OPTIONS

=over 8

=item B<-u Package>

Normally, Lint only checks the main code of the program together
with all subs defined in package main. The B<-u> option lets you
include other package names whose subs are then checked by Lint.

=back

=head1 BUGS

This is only a very preliminary version.

This module doesn't work correctly on thread-enabled perls.

=head1 AUTHOR

Malcolm Beattie, mbeattie@sable.ox.ac.uk.

=cut

use strict;
use B qw(walkoptree_slow main_root walksymtable svref_2object parents
         OPf_WANT_LIST OPf_WANT OPf_STACKED G_ARRAY SVf_POK
        );

my $file = "unknown";		# shadows current filename
my $line = 0;			# shadows current line number
my $curstash = "main";		# shadows current stash

# Lint checks
my %check;
my %implies_ok_context;
BEGIN {
    map($implies_ok_context{$_}++,
	qw(scalar av2arylen aelem aslice helem hslice
	   keys values hslice defined undef delete));
}

# Lint checks turned on by default
my @default_checks = qw(context);

my %valid_check;
# All valid checks
BEGIN {
    map($valid_check{$_}++,
	qw(context implicit_read implicit_write dollar_underscore
	   private_names bare_subs undefined_subs regexp_variables));
}

# Debugging options
my ($debug_op);

my %done_cv;		# used to mark which subs have already been linted
my @extra_packages;	# Lint checks mainline code and all subs which are
			# in main:: or in one of these packages.

sub warning {
    my $format = (@_ < 2) ? "%s" : shift;
    warn sprintf("$format at %s line %d\n", @_, $file, $line);
}

# This gimme can't cope with context that's only determined
# at runtime via dowantarray().
sub gimme {
    my $op = shift;
    my $flags = $op->flags;
    if ($flags & OPf_WANT) {
	return(($flags & OPf_WANT) == OPf_WANT_LIST ? 1 : 0);
    }
    return undef;
}

sub B::OP::lint {}

sub B::COP::lint {
    my $op = shift;
    if ($op->name eq "nextstate") {
	$file = $op->file;
	$line = $op->line;
	$curstash = $op->stash->NAME;
    }
}

sub B::UNOP::lint {
    my $op = shift;
    my $opname = $op->name;
    if ($check{context} && ($opname eq "rv2av" || $opname eq "rv2hv")) {
	my $parent = parents->[0];
	my $pname = $parent->name;
	return if gimme($op) || $implies_ok_context{$pname};
	# Two special cases to deal with: "foreach (@foo)" and "delete $a{$b}"
	# null out the parent so we have to check for a parent of pp_null and
	# a grandparent of pp_enteriter or pp_delete
	if ($pname eq "null") {
	    my $gpname = parents->[1]->name;
	    return if $gpname eq "enteriter" || $gpname eq "delete";
	}
	warning("Implicit scalar context for %s in %s",
		$opname eq "rv2av" ? "array" : "hash", $parent->desc);
    }
    if ($check{private_names} && $opname eq "method") {
	my $methop = $op->first;
	if ($methop->name eq "const") {
	    my $method = $methop->sv->PV;
	    if ($method =~ /^_/ && !defined(&{"$curstash\::$method"})) {
		warning("Illegal reference to private method name $method");
	    }
	}
    }
}

sub B::PMOP::lint {
    my $op = shift;
    if ($check{implicit_read}) {
	if ($op->name eq "match" && !($op->flags & OPf_STACKED)) {
	    warning('Implicit match on $_');
	}
    }
    if ($check{implicit_write}) {
	if ($op->name eq "subst" && !($op->flags & OPf_STACKED)) {
	    warning('Implicit substitution on $_');
	}
    }
}

sub B::LOOP::lint {
    my $op = shift;
    if ($check{implicit_read} || $check{implicit_write}) {
	if ($op->name eq "enteriter") {
	    my $last = $op->last;
	    if ($last->name eq "gv" && $last->gv->NAME eq "_") {
		warning('Implicit use of $_ in foreach');
	    }
	}
    }
}

sub B::SVOP::lint {
    my $op = shift;
    if ( $check{bare_subs} && $op->name eq 'const'
         && $op->private & 64 )		# OPpCONST_BARE = 64 in op.h
    {
	my $sv = $op->sv;
	if( $sv->FLAGS & SVf_POK && exists &{$curstash.'::'.$sv->PV} ) {
	    warning "Bare sub name '" . $sv->PV . "' interpreted as string";
	}
    }
    if ($check{dollar_underscore} && $op->name eq "gvsv"
	&& $op->gv->NAME eq "_")
    {
	warning('Use of $_');
    }
    if ($check{private_names}) {
	my $opname = $op->name;
	if ($opname eq "gv" || $opname eq "gvsv") {
	    my $gv = $op->gv;
	    if ($gv->NAME =~ /^_./ && $gv->STASH->NAME ne $curstash) {
		warning('Illegal reference to private name %s', $gv->NAME);
	    }
	} elsif ($opname eq "method_named") {
	    my $method = $op->gv->PV;
	    if ($method =~ /^_./) {
		warning("Illegal reference to private method name $method");
	    }
	}
    }
    if ($check{undefined_subs}) {
	if ($op->name eq "gv"
	    && $op->next->name eq "entersub")
	{
	    my $gv = $op->gv;
	    my $subname = $gv->STASH->NAME . "::" . $gv->NAME;
	    no strict 'refs';
	    if (!defined(&$subname)) {
		$subname =~ s/^main:://;
		warning('Undefined subroutine %s called', $subname);
	    }
	}
    }
    if ($check{regexp_variables} && $op->name eq "gvsv") {
	my $name = $op->gv->NAME;
	if ($name =~ /^[&'`]$/) {
	    warning('Use of regexp variable $%s', $name);
	}
    }
}

sub B::GV::lintcv {
    my $gv = shift;
    my $cv = $gv->CV;
    #warn sprintf("lintcv: %s::%s (done=%d)\n",
    #		 $gv->STASH->NAME, $gv->NAME, $done_cv{$$cv});#debug
    return if !$$cv || $done_cv{$$cv}++;
    my $root = $cv->ROOT;
    #warn "    root = $root (0x$$root)\n";#debug
    walkoptree_slow($root, "lint") if $$root;
}

sub do_lint {
    my %search_pack;
    walkoptree_slow(main_root, "lint") if ${main_root()};
    
    # Now do subs in main
    no strict qw(vars refs);
    local(*glob);
    for my $sym (keys %main::) {
	next if $sym =~ /::$/;
	*glob = $main::{$sym};
        svref_2object(\*glob)->EGV->lintcv;
    }

    # Now do subs in non-main packages given by -u options
    map { $search_pack{$_} = 1 } @extra_packages;
    walksymtable(\%{"main::"}, "lintcv", sub {
	my $package = shift;
	$package =~ s/::$//;
	#warn "Considering $package\n";#debug
	return exists $search_pack{$package};
    });
}

sub compile {
    my @options = @_;
    my ($option, $opt, $arg);
    # Turn on default lint checks
    for $opt (@default_checks) {
	$check{$opt} = 1;
    }
  OPTION:
    while ($option = shift @options) {
	if ($option =~ /^-(.)(.*)/) {
	    $opt = $1;
	    $arg = $2;
	} else {
	    unshift @options, $option;
	    last OPTION;
	}
	if ($opt eq "-" && $arg eq "-") {
	    shift @options;
	    last OPTION;
	} elsif ($opt eq "D") {
            $arg ||= shift @options;
	    foreach $arg (split(//, $arg)) {
		if ($arg eq "o") {
		    B->debug(1);
		} elsif ($arg eq "O") {
		    $debug_op = 1;
		}
	    }
	} elsif ($opt eq "u") {
	    $arg ||= shift @options;
	    push(@extra_packages, $arg);
	}
    }
    foreach $opt (@default_checks, @options) {
	$opt =~ tr/-/_/;
	if ($opt eq "all") {
	    %check = %valid_check;
	}
	elsif ($opt eq "none") {
	    %check = ();
	}
	else {
	    if ($opt =~ s/^no_//) {
		$check{$opt} = 0;
	    }
	    else {
		$check{$opt} = 1;
	    }
	    warn "No such check: $opt\n" unless defined $valid_check{$opt};
	}
    }
    # Remaining arguments are things to check
    
    return \&do_lint;
}

1;
Commit	Line	Data
a798dbf2	1	package B::Lint;
a798dbf2	2
4522225b	3	our $VERSION = '1.02';
28b605d8	4
a798dbf2	5	=head1 NAME
	6
	7	B::Lint - Perl lint
	8
	9	=head1 SYNOPSIS
	10
	11	perl -MO=Lint[,OPTIONS] foo.pl
	12
	13	=head1 DESCRIPTION
	14
	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 B<lint> which carries
	17	out a similar process for C programs.
	18
	19	=head1 OPTIONS AND LINT CHECKS
	20
	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:
	29
	30	=over 8
	31
	32	=item B<context>
	33
	34	Produces a warning whenever an array is used in an implicit scalar
	35	context. For example, both of the lines
	36
	37	$foo = length(@bar);
	38	$foo = @bar;
	39	will elicit a warning. Using an explicit B<scalar()> silences the
	40	warning. For example,
	41
	42	$foo = scalar(@bar);
	43
	44	=item B<implicit-read> and B<implicit-write>
	45
	46	These options produce a warning whenever an operation implicitly
	47	reads or (respectively) writes to one of Perl's special variables.
	48	For example, B<implicit-read> will warn about these:
	49
	50	/foo/;
	51
	52	and B<implicit-write> will warn about these:
	53
	54	s/foo/bar/;
	55
	56	Both B<implicit-read> and B<implicit-write> warn about this:
	57
	58	for (@a) { ... }
	59
40f1df11	60	=item B<bare-subs>
	61
	62	This option warns whenever a bareword is implicitly quoted, but is also
	63	the name of a subroutine in the current package. Typical mistakes that it will
	64	trap are:
	65
	66	use constant foo => 'bar';
	67	@a = ( foo => 1 );
	68	$b{foo} = 2;
	69
	70	Neither of these will do what a naive user would expect.
	71
a798dbf2	72	=item B<dollar-underscore>
	73
	74	This option warns whenever $_ is used either explicitly anywhere or
	75	as the implicit argument of a B<print> statement.
	76
	77	=item B<private-names>
	78
	79	This option warns on each use of any variable, subroutine or
	80	method name that lives in a non-current package but begins with
	81	an underscore ("_"). Warnings aren't issued for the special case
	82	of the single character name "_" by itself (e.g. $_ and @_).
	83
	84	=item B<undefined-subs>
	85
	86	This option warns whenever an undefined subroutine is invoked.
	87	This option will only catch explicitly invoked subroutines such
	88	as C<foo()> and not indirect invocations such as C<&$subref()>
	89	or C<$obj-E<gt>meth()>. Note that some programs or modules delay
	90	definition of subs until runtime by means of the AUTOLOAD
	91	mechanism.
	92
	93	=item B<regexp-variables>
	94
	95	This option warns whenever one of the regexp variables $', $& or
	96	$' is used. Any occurrence of any of these variables in your
	97	program can slow your whole program down. See L<perlre> for
	98	details.
	99
	100	=item B<all>
	101
	102	Turn all warnings on.
	103
	104	=item B<none>
	105
	106	Turn all warnings off.
	107
	108	=back
	109
	110	=head1 NON LINT-CHECK OPTIONS
	111
	112	=over 8
	113
	114	=item B<-u Package>
	115
	116	Normally, Lint only checks the main code of the program together
	117	with all subs defined in package main. The B<-u> option lets you
	118	include other package names whose subs are then checked by Lint.
	119
	120	=back
	121
	122	=head1 BUGS
	123
	124	This is only a very preliminary version.
	125
94011a57	126	This module doesn't work correctly on thread-enabled perls.
94011a57	127
a798dbf2	128	=head1 AUTHOR
	129
	130	Malcolm Beattie, mbeattie@sable.ox.ac.uk.
	131
	132	=cut
	133
	134	use strict;
b0a2b4f5	135	use B qw(walkoptree_slow main_root walksymtable svref_2object parents
40f1df11	136	OPf_WANT_LIST OPf_WANT OPf_STACKED G_ARRAY SVf_POK
4c1f658f	137	);
a798dbf2	138
	139	my $file = "unknown"; # shadows current filename
	140	my $line = 0; # shadows current line number
	141	my $curstash = "main"; # shadows current stash
	142
	143	# Lint checks
	144	my %check;
	145	my %implies_ok_context;
	146	BEGIN {
	147	map($implies_ok_context{$_}++,
3f872cb9	148	qw(scalar av2arylen aelem aslice helem hslice
3f872cb9	149	keys values hslice defined undef delete));
a798dbf2	150	}
	151
	152	# Lint checks turned on by default
	153	my @default_checks = qw(context);
	154
	155	my %valid_check;
	156	# All valid checks
	157	BEGIN {
	158	map($valid_check{$_}++,
	159	qw(context implicit_read implicit_write dollar_underscore
40f1df11	160	private_names bare_subs undefined_subs regexp_variables));
a798dbf2	161	}
	162
	163	# Debugging options
	164	my ($debug_op);
	165
	166	my %done_cv; # used to mark which subs have already been linted
	167	my @extra_packages; # Lint checks mainline code and all subs which are
	168	# in main:: or in one of these packages.
	169
	170	sub warning {
	171	my $format = (@_ < 2) ? "%s" : shift;
	172	warn sprintf("$format at %s line %d\n", @_, $file, $line);
	173	}
	174
	175	# This gimme can't cope with context that's only determined
	176	# at runtime via dowantarray().
	177	sub gimme {
	178	my $op = shift;
	179	my $flags = $op->flags;
4c1f658f	180	if ($flags & OPf_WANT) {
94011a57	181	return(($flags & OPf_WANT) == OPf_WANT_LIST ? 1 : 0);
a798dbf2	182	}
	183	return undef;
	184	}
	185
	186	sub B::OP::lint {}
	187
	188	sub B::COP::lint {
	189	my $op = shift;
3f872cb9	190	if ($op->name eq "nextstate") {
57843af0	191	$file = $op->file;
a798dbf2	192	$line = $op->line;
	193	$curstash = $op->stash->NAME;
	194	}
	195	}
	196
	197	sub B::UNOP::lint {
	198	my $op = shift;
3f872cb9	199	my $opname = $op->name;
3f872cb9	200	if ($check{context} && ($opname eq "rv2av" \|\| $opname eq "rv2hv")) {
a798dbf2	201	my $parent = parents->[0];
3f872cb9	202	my $pname = $parent->name;
a798dbf2	203	return if gimme($op) \|\| $implies_ok_context{$pname};
	204	# Two special cases to deal with: "foreach (@foo)" and "delete $a{$b}"
	205	# null out the parent so we have to check for a parent of pp_null and
	206	# a grandparent of pp_enteriter or pp_delete
3f872cb9	207	if ($pname eq "null") {
	208	my $gpname = parents->[1]->name;
	209	return if $gpname eq "enteriter" \|\| $gpname eq "delete";
a798dbf2	210	}
a798dbf2	211	warning("Implicit scalar context for %s in %s",
3f872cb9	212	$opname eq "rv2av" ? "array" : "hash", $parent->desc);
a798dbf2	213	}
3f872cb9	214	if ($check{private_names} && $opname eq "method") {
a798dbf2	215	my $methop = $op->first;
3f872cb9	216	if ($methop->name eq "const") {
a798dbf2	217	my $method = $methop->sv->PV;
	218	if ($method =~ /^_/ && !defined(&{"$curstash\::$method"})) {
	219	warning("Illegal reference to private method name $method");
	220	}
	221	}
	222	}
	223	}
	224
	225	sub B::PMOP::lint {
	226	my $op = shift;
	227	if ($check{implicit_read}) {
3f872cb9	228	if ($op->name eq "match" && !($op->flags & OPf_STACKED)) {
a798dbf2	229	warning('Implicit match on $_');
	230	}
	231	}
	232	if ($check{implicit_write}) {
3f872cb9	233	if ($op->name eq "subst" && !($op->flags & OPf_STACKED)) {
a798dbf2	234	warning('Implicit substitution on $_');
	235	}
	236	}
	237	}
	238
	239	sub B::LOOP::lint {
	240	my $op = shift;
	241	if ($check{implicit_read} \|\| $check{implicit_write}) {
3f872cb9	242	if ($op->name eq "enteriter") {
a798dbf2	243	my $last = $op->last;
3f872cb9	244	if ($last->name eq "gv" && $last->gv->NAME eq "_") {
a798dbf2	245	warning('Implicit use of $_ in foreach');
	246	}
	247	}
	248	}
	249	}
	250
7934575e	251	sub B::SVOP::lint {
a798dbf2	252	my $op = shift;
40f1df11	253	if ( $check{bare_subs} && $op->name eq 'const'
	254	&& $op->private & 64 ) # OPpCONST_BARE = 64 in op.h
	255	{
	256	my $sv = $op->sv;
	257	if( $sv->FLAGS & SVf_POK && exists &{$curstash.'::'.$sv->PV} ) {
	258	warning "Bare sub name '" . $sv->PV . "' interpreted as string";
	259	}
	260	}
3f872cb9	261	if ($check{dollar_underscore} && $op->name eq "gvsv"
a798dbf2	262	&& $op->gv->NAME eq "_")
	263	{
	264	warning('Use of $_');
	265	}
	266	if ($check{private_names}) {
3f872cb9	267	my $opname = $op->name;
4f25aa18	268	if ($opname eq "gv" \|\| $opname eq "gvsv") {
7934575e	269	my $gv = $op->gv;
	270	if ($gv->NAME =~ /^_./ && $gv->STASH->NAME ne $curstash) {
	271	warning('Illegal reference to private name %s', $gv->NAME);
	272	}
bfecbe02	273	} elsif ($opname eq "method_named") {
	274	my $method = $op->gv->PV;
	275	if ($method =~ /^_./) {
	276	warning("Illegal reference to private method name $method");
	277	}
a798dbf2	278	}
	279	}
	280	if ($check{undefined_subs}) {
3f872cb9	281	if ($op->name eq "gv"
	282	&& $op->next->name eq "entersub")
	283	{
a798dbf2	284	my $gv = $op->gv;
	285	my $subname = $gv->STASH->NAME . "::" . $gv->NAME;
	286	no strict 'refs';
	287	if (!defined(&$subname)) {
	288	$subname =~ s/^main:://;
	289	warning('Undefined subroutine %s called', $subname);
	290	}
	291	}
	292	}
3f872cb9	293	if ($check{regexp_variables} && $op->name eq "gvsv") {
a798dbf2	294	my $name = $op->gv->NAME;
	295	if ($name =~ /^[&'`]$/) {
	296	warning('Use of regexp variable $%s', $name);
	297	}
	298	}
	299	}
	300
	301	sub B::GV::lintcv {
	302	my $gv = shift;
	303	my $cv = $gv->CV;
	304	#warn sprintf("lintcv: %s::%s (done=%d)\n",
	305	# $gv->STASH->NAME, $gv->NAME, $done_cv{$$cv});#debug
	306	return if !$$cv \|\| $done_cv{$$cv}++;
	307	my $root = $cv->ROOT;
	308	#warn " root = $root (0x$$root)\n";#debug
b0a2b4f5	309	walkoptree_slow($root, "lint") if $$root;
a798dbf2	310	}
	311
	312	sub do_lint {
	313	my %search_pack;
b0a2b4f5	314	walkoptree_slow(main_root, "lint") if ${main_root()};
a798dbf2	315
	316	# Now do subs in main
	317	no strict qw(vars refs);
a798dbf2	318	local(*glob);
0091380b	319	for my $sym (keys %main::) {
	320	next if $sym =~ /::$/;
	321	*glob = $main::{$sym};
	322	svref_2object(\*glob)->EGV->lintcv;
a798dbf2	323	}
	324
	325	# Now do subs in non-main packages given by -u options
	326	map { $search_pack{$_} = 1 } @extra_packages;
	327	walksymtable(\%{"main::"}, "lintcv", sub {
	328	my $package = shift;
	329	$package =~ s/::$//;
	330	#warn "Considering $package\n";#debug
	331	return exists $search_pack{$package};
	332	});
	333	}
	334
	335	sub compile {
	336	my @options = @_;
	337	my ($option, $opt, $arg);
	338	# Turn on default lint checks
	339	for $opt (@default_checks) {
	340	$check{$opt} = 1;
	341	}
	342	OPTION:
	343	while ($option = shift @options) {
	344	if ($option =~ /^-(.)(.*)/) {
	345	$opt = $1;
	346	$arg = $2;
	347	} else {
	348	unshift @options, $option;
	349	last OPTION;
	350	}
	351	if ($opt eq "-" && $arg eq "-") {
	352	shift @options;
	353	last OPTION;
	354	} elsif ($opt eq "D") {
	355	$arg \|\|= shift @options;
	356	foreach $arg (split(//, $arg)) {
	357	if ($arg eq "o") {
	358	B->debug(1);
	359	} elsif ($arg eq "O") {
	360	$debug_op = 1;
	361	}
	362	}
	363	} elsif ($opt eq "u") {
	364	$arg \|\|= shift @options;
	365	push(@extra_packages, $arg);
	366	}
	367	}
	368	foreach $opt (@default_checks, @options) {
	369	$opt =~ tr/-/_/;
	370	if ($opt eq "all") {
	371	%check = %valid_check;
	372	}
	373	elsif ($opt eq "none") {
	374	%check = ();
	375	}
	376	else {
7f0faf35	377	if ($opt =~ s/^no_//) {
a798dbf2	378	$check{$opt} = 0;
	379	}
	380	else {
	381	$check{$opt} = 1;
	382	}
	383	warn "No such check: $opt\n" unless defined $valid_check{$opt};
	384	}
	385	}
	386	# Remaining arguments are things to check
	387
	388	return \&do_lint;
	389	}
	390
	391	1;