+++ /dev/null
-package B::Lint;
-use if $] > 5.017, 'deprecate';
-
-our $VERSION = '1.17'; ## no critic
-
-=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 F<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<magic-diamond>
-
-Produces a warning whenever the magic C<E<lt>E<gt>> readline is
-used. Internally it uses perl's two-argument open which itself treats
-filenames with special characters specially. This could allow
-interestingly named files to have unexpected effects when reading.
-
- % touch 'rm *|'
- % perl -pe 1
-
-The above creates a file named C<rm *|>. When perl opens it with
-C<E<lt>E<gt>> it actually executes the shell program C<rm *>. This
-makes C<E<lt>E<gt>> dangerous to use carelessly.
-
-=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 C<$_> 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. C<$_> and C<@_>).
-
-=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 C<$`>, C<$&> or C<$'>
-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 EXTENDING LINT
-
-Lint can be extended by with plugins. Lint uses L<Module::Pluggable>
-to find available plugins. Plugins are expected but not required to
-inform Lint of which checks they are adding.
-
-The C<< B::Lint->register_plugin( MyPlugin => \@new_checks ) >> method
-adds the list of C<@new_checks> to the list of valid checks. If your
-module wasn't loaded by L<Module::Pluggable> then your class name is
-added to the list of plugins.
-
-You must create a C<match( \%checks )> method in your plugin class or one
-of its parents. It will be called on every op as a regular method call
-with a hash ref of checks as its parameter.
-
-The class methods C<< B::Lint->file >> and C<< B::Lint->line >> contain
-the current filename and line number.
-
- package Sample;
- use B::Lint;
- B::Lint->register_plugin( Sample => [ 'good_taste' ] );
-
- sub match {
- my ( $op, $checks_href ) = shift @_;
- if ( $checks_href->{good_taste} ) {
- ...
- }
- }
-
-=head1 TODO
-
-=over
-
-=item while(<FH>) stomps $_
-
-=item strict oo
-
-=item unchecked system calls
-
-=item more tests, validate against older perls
-
-=back
-
-=head1 BUGS
-
-This is only a very preliminary version.
-
-=head1 AUTHOR
-
-Malcolm Beattie, mbeattie@sable.ox.ac.uk.
-
-=head1 ACKNOWLEDGEMENTS
-
-Sebastien Aperghis-Tramoni - bug fixes
-
-=cut
-
-use strict;
-use B qw( walkoptree_slow
- main_root main_cv walksymtable parents
- OPpOUR_INTRO
- OPf_WANT_VOID OPf_WANT_LIST OPf_WANT OPf_STACKED SVf_POK );
-use Carp 'carp';
-
-# The current M::P doesn't know about .pmc files.
-use Module::Pluggable ( require => 1 );
-
-use List::Util 'first';
-## no critic Prototypes
-sub any (&@) { my $test = shift @_; $test->() and return 1 for @_; return 0 }
-
-BEGIN {
-
- # Import or create some constants from B. B doesn't provide
- # everything I need so some things like OPpCONST_BARE are defined
- # here.
- for my $sym ( qw( begin_av check_av init_av end_av ),
- [ 'OPpCONST_BARE' => 64 ] )
- {
- my $val;
- ( $sym, $val ) = @$sym if ref $sym;
-
- if ( any { $sym eq $_ } @B::EXPORT_OK, @B::EXPORT ) {
- B->import($sym);
- }
- else {
- require constant;
- constant->import( $sym => $val );
- }
- }
-}
-
-my $file = "unknown"; # shadows current filename
-my $line = 0; # shadows current line number
-my $curstash = "main"; # shadows current stash
-my $curcv; # shadows current B::CV for pad lookups
-
-sub file {$file}
-sub line {$line}
-sub curstash {$curstash}
-sub curcv {$curcv}
-
-# Lint checks
-my %check;
-my %implies_ok_context;
-
-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 magic_diamond undefined_subs regexp_variables);
-
-my %valid_check;
-
-# All valid checks
-for my $check (
- qw(context implicit_read implicit_write dollar_underscore
- private_names bare_subs undefined_subs regexp_variables
- magic_diamond )
- )
-{
- $valid_check{$check} = __PACKAGE__;
-}
-
-# 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 );
- return undef; ## no critic undef
-}
-
-# 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; ## no critic undef
-}
-
-my @plugins = __PACKAGE__->plugins;
-
-sub inside_grepmap {
-
- # A boolean function to be used while inside a B::walkoptree_slow
- # call. If we are in the EXPR part of C<grep EXPR, ...> or C<grep
- # { EXPR } ...>, this returns true.
- return any { $_->name =~ m/\A(?:grep|map)/xms } @{ parents() };
-}
-
-sub inside_foreach_modifier {
-
- # TODO: use any()
-
- # A boolean function to be used while inside a B::walkoptree_slow
- # call. If we are in the EXPR part of C<EXPR foreach ...> this
- # returns true.
- for my $ancestor ( @{ parents() } ) {
- next unless $ancestor->name eq 'leaveloop';
-
- my $first = $ancestor->first;
- next unless $first->name eq 'enteriter';
-
- next if $first->redoop->name =~ m/\A(?:next|db|set)state\z/xms;
-
- return 1;
- }
- return 0;
-}
-
-for (
- [qw[ B::PADOP::gv_harder gv padix]],
- [qw[ B::SVOP::sv_harder sv targ]],
- [qw[ B::SVOP::gv_harder gv padix]]
- )
-{
-
- # I'm generating some functions here because they're mostly
- # similar. It's all for compatibility with threaded
- # perl. Perhaps... this code should inspect $Config{usethreads}
- # and generate a *specific* function. I'm leaving it generic for
- # the moment.
- #
- # In threaded perl SVs and GVs aren't used directly in the optrees
- # like they are in non-threaded perls. The ops that would use a SV
- # or GV keep an index into the subroutine's scratchpad. I'm
- # currently ignoring $cv->DEPTH and that might be at my peril.
-
- my ( $subname, $attr, $pad_attr ) = @$_;
- my $target = do { ## no critic strict
- no strict 'refs';
- \*$subname;
- };
- *$target = sub {
- my ($op) = @_;
-
- my $elt;
- if ( not $op->isa('B::PADOP') ) {
- $elt = $op->$attr;
- }
- return $elt if eval { $elt->isa('B::SV') };
-
- my $ix = $op->$pad_attr;
- my @entire_pad = $curcv->PADLIST->ARRAY;
- my @elts = map +( $_->ARRAY )[$ix], @entire_pad;
- ($elt) = first {
- eval { $_->isa('B::SV') } ? $_ : ();
- }
- @elts[ 0, reverse 1 .. $#elts ];
- return $elt;
- };
-}
-
-sub B::OP::lint {
- my ($op) = @_;
-
- # This is a fallback ->lint for all the ops where I haven't
- # defined something more specific. Nothing happens here.
-
- # Call all registered plugins
- my $m;
- $m = $_->can('match'), $op->$m( \%check ) for @plugins;
- return;
-}
-
-sub B::COP::lint {
- my ($op) = @_;
-
- # nextstate ops sit between statements. Whenever I see one I
- # update the current info on file, line, and stash. This code also
- # updates it when it sees a dbstate or setstate op. I have no idea
- # what those are but having seen them mentioned together in other
- # parts of the perl I think they're kind of equivalent.
- if ( $op->name =~ m/\A(?:next|db|set)state\z/ ) {
- $file = $op->file;
- $line = $op->line;
- $curstash = $op->stash->NAME;
- }
-
- # Call all registered plugins
- my $m;
- $m = $_->can('match'), $op->$m( \%check ) for @plugins;
- return;
-}
-
-sub B::UNOP::lint {
- my ($op) = @_;
-
- my $opname = $op->name;
-
-CONTEXT: {
-
- # Check arrays and hashes in scalar or void context where
- # scalar() hasn't been used.
-
- next
- unless $check{context}
- and $opname =~ m/\Arv2[ah]v\z/xms
- and not gimme($op);
-
- my ( $parent, $gparent ) = @{ parents() }[ 0, 1 ];
- my $pname = $parent->name;
-
- next if $implies_ok_context{$pname};
-
- # Three special cases to deal with: "foreach (@foo)", "delete
- # $a{$b}", and "exists $a{$b}" null out the parent so we have to
- # check for a parent of pp_null and a grandparent of
- # pp_enteriter, pp_delete, pp_exists
-
- next
- if $pname eq "null"
- and $gparent->name =~ m/\A(?:delete|enteriter|exists)\z/xms;
-
- # our( @bar ); would also trigger this error so I exclude
- # that.
- next
- if $op->private & OPpOUR_INTRO
- and ( $op->flags & OPf_WANT ) == OPf_WANT_VOID;
-
- warning 'Implicit scalar context for %s in %s',
- $opname eq "rv2av" ? "array" : "hash", $parent->desc;
- }
-
-PRIVATE_NAMES: {
-
- # Looks for calls to methods with names that begin with _ and
- # that aren't visible within the current package. Maybe this
- # should look at @ISA.
- next
- unless $check{private_names}
- and $opname =~ m/\Amethod/xms;
-
- my $methop = $op->first;
- next unless $methop->name eq "const";
-
- my $method = $methop->sv_harder->PV;
- next
- unless $method =~ m/\A_/xms
- and not defined &{"$curstash\::$method"};
-
- warning q[Illegal reference to private method name '%s'], $method;
- }
-
- # Call all registered plugins
- my $m;
- $m = $_->can('match'), $op->$m( \%check ) for @plugins;
- return;
-}
-
-sub B::PMOP::lint {
- my ($op) = @_;
-
-IMPLICIT_READ: {
-
- # Look for /.../ that doesn't use =~ to bind to something.
- next
- unless $check{implicit_read}
- and $op->name eq "match"
- and not( $op->flags & OPf_STACKED
- or inside_grepmap() );
- warning 'Implicit match on $_';
- }
-
-IMPLICIT_WRITE: {
-
- # Look for s/.../.../ that doesn't use =~ to bind to
- # something.
- next
- unless $check{implicit_write}
- and $op->name eq "subst"
- and not $op->flags & OPf_STACKED;
- warning 'Implicit substitution on $_';
- }
-
- # Call all registered plugins
- my $m;
- $m = $_->can('match'), $op->$m( \%check ) for @plugins;
- return;
-}
-
-sub B::LOOP::lint {
- my ($op) = @_;
-
-IMPLICIT_FOO: {
-
- # Look for C<for ( ... )>.
- next
- unless ( $check{implicit_read} or $check{implicit_write} )
- and $op->name eq "enteriter";
-
- my $last = $op->last;
- next
- unless $last->name eq "gv"
- and $last->gv_harder->NAME eq "_"
- and $op->redoop->name =~ m/\A(?:next|db|set)state\z/xms;
-
- warning 'Implicit use of $_ in foreach';
- }
-
- # Call all registered plugins
- my $m;
- $m = $_->can('match'), $op->$m( \%check ) for @plugins;
- return;
-}
-
-# In threaded vs non-threaded perls you'll find that threaded perls
-# use PADOP in place of SVOPs so they can do lookups into the
-# scratchpad to find things. I suppose this is so a optree can be
-# shared between threads and all symbol table muckery will just get
-# written to a scratchpad.
-*B::PADOP::lint = *B::PADOP::lint = \&B::SVOP::lint;
-
-sub B::SVOP::lint {
- my ($op) = @_;
-
-MAGIC_DIAMOND: {
- next
- unless $check{magic_diamond}
- and parents()->[0]->name eq 'readline'
- and $op->gv_harder->NAME eq 'ARGV';
-
- warning 'Use of <>';
- }
-
-BARE_SUBS: {
- next
- unless $check{bare_subs}
- and $op->name eq 'const'
- and $op->private & OPpCONST_BARE;
-
- my $sv = $op->sv_harder;
- next unless $sv->FLAGS & SVf_POK;
-
- my $sub = $sv->PV;
- my $subname = "$curstash\::$sub";
-
- # I want to skip over things that were declared with the
- # constant pragma. Well... sometimes. Hmm. I want to ignore
- # C<<use constant FOO => ...>> but warn on C<<FOO => ...>>
- # later. The former is typical declaration syntax and the
- # latter would be an error.
- #
- # Skipping over both could be handled by looking if
- # $constant::declared{$subname} is true.
-
- # Check that it's a function.
- next
- unless exists &{"$curstash\::$sub"};
-
- warning q[Bare sub name '%s' interpreted as string], $sub;
- }
-
-PRIVATE_NAMES: {
- next unless $check{private_names};
-
- my $opname = $op->name;
- if ( $opname =~ m/\Agv(?:sv)?\z/xms ) {
-
- # Looks for uses of variables and stuff that are named
- # private and we're not in the same package.
- my $gv = $op->gv_harder;
- my $name = $gv->NAME;
- next
- unless $name =~ m/\A_./xms
- and $gv->STASH->NAME ne $curstash;
-
- warning q[Illegal reference to private name '%s'], $name;
- }
- elsif ( $opname eq "method_named" ) {
- my $method = $op->sv_harder->PV;
- next unless $method =~ m/\A_./xms;
-
- warning q[Illegal reference to private method name '%s'], $method;
- }
- }
-
-DOLLAR_UNDERSCORE: {
-
- # Warn on uses of $_ with a few exceptions. I'm not warning on
- # $_ inside grep, map, or statement modifier foreach because
- # they localize $_ and it'd be impossible to use these
- # features without getting warnings.
-
- next
- unless $check{dollar_underscore}
- and $op->name eq "gvsv"
- and $op->gv_harder->NAME eq "_"
- and not( inside_grepmap
- or inside_foreach_modifier );
-
- warning 'Use of $_';
- }
-
-REGEXP_VARIABLES: {
-
- # Look for any uses of $`, $&, or $'.
- next
- unless $check{regexp_variables}
- and $op->name eq "gvsv";
-
- my $name = $op->gv_harder->NAME;
- next unless $name =~ m/\A[\&\'\`]\z/xms;
-
- warning 'Use of regexp variable $%s', $name;
- }
-
-UNDEFINED_SUBS: {
-
- # Look for calls to functions that either don't exist or don't
- # have a definition.
- next
- unless $check{undefined_subs}
- and $op->name eq "gv"
- and $op->next->name eq "entersub";
-
- my $gv = $op->gv_harder;
- my $subname = $gv->STASH->NAME . "::" . $gv->NAME;
-
- no strict 'refs'; ## no critic strict
- if ( not exists &$subname ) {
- $subname =~ s/\Amain:://;
- warning q[Nonexistent subroutine '%s' called], $subname;
- }
- elsif ( not defined &$subname ) {
- $subname =~ s/\A\&?main:://;
- warning q[Undefined subroutine '%s' called], $subname;
- }
- }
-
- # Call all registered plugins
- my $m;
- $m = $_->can('match'), $op->$m( \%check ) for @plugins;
- return;
-}
-
-sub B::GV::lintcv {
-
- # Example: B::svref_2object( \ *A::Glob )->lintcv
-
- my $gv = shift @_;
- my $cv = $gv->CV;
- return unless $cv->can('lintcv');
- $cv->lintcv;
- return;
-}
-
-sub B::CV::lintcv {
-
- # Example: B::svref_2object( \ &foo )->lintcv
-
- # Write to the *global* $
- $curcv = shift @_;
-
- #warn sprintf("lintcv: %s::%s (done=%d)\n",
- # $gv->STASH->NAME, $gv->NAME, $done_cv{$$curcv});#debug
- return unless ref($curcv) and $$curcv and not $done_cv{$$curcv}++;
- my $root = $curcv->ROOT;
-
- #warn " root = $root (0x$$root)\n";#debug
- walkoptree_slow( $root, "lint" ) if $$root;
- return;
-}
-
-sub do_lint {
- my %search_pack;
-
- # Copy to the global $curcv for use in pad lookups.
- $curcv = main_cv;
- walkoptree_slow( main_root, "lint" ) if ${ main_root() };
-
- # Do all the miscellaneous non-sub blocks.
- for my $av ( begin_av, init_av, check_av, end_av ) {
- next unless eval { $av->isa('B::AV') };
- for my $cv ( $av->ARRAY ) {
- next unless ref($cv) and $cv->FILE eq $0;
- $cv->lintcv;
- }
- }
-
- walksymtable(
- \%main::,
- sub {
- if ( $_[0]->FILE eq $0 ) { $_[0]->lintcv }
- },
- sub {1}
- );
- return;
-}
-
-sub compile {
- my @options = @_;
-
- # Turn on default lint checks
- for my $opt (@default_checks) {
- $check{$opt} = 1;
- }
-
-OPTION:
- while ( my $option = shift @options ) {
- my ( $opt, $arg );
- unless ( ( $opt, $arg ) = $option =~ m/\A-(.)(.*)/xms ) {
- unshift @options, $option;
- last OPTION;
- }
-
- if ( $opt eq "-" && $arg eq "-" ) {
- shift @options;
- last OPTION;
- }
- elsif ( $opt eq "D" ) {
- $arg ||= shift @options;
- foreach my $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 my $opt ( @default_checks, @options ) {
- $opt =~ tr/-/_/;
- if ( $opt eq "all" ) {
- %check = %valid_check;
- }
- elsif ( $opt eq "none" ) {
- %check = ();
- }
- else {
- if ( $opt =~ s/\Ano_//xms ) {
- $check{$opt} = 0;
- }
- else {
- $check{$opt} = 1;
- }
- carp "No such check: $opt"
- unless defined $valid_check{$opt};
- }
- }
-
- # Remaining arguments are things to check. So why aren't I
- # capturing them or something? I don't know.
-
- return \&do_lint;
-}
-
-sub register_plugin {
- my ( undef, $plugin, $new_checks ) = @_;
-
- # Allow the user to be lazy and not give us a name.
- $plugin = caller unless defined $plugin;
-
- # Register the plugin's named checks, if any.
- for my $check ( eval {@$new_checks} ) {
- if ( not defined $check ) {
- carp 'Undefined value in checks.';
- next;
- }
- if ( exists $valid_check{$check} ) {
- carp
- "$check is already registered as a $valid_check{$check} feature.";
- next;
- }
-
- $valid_check{$check} = $plugin;
- }
-
- # Register a non-Module::Pluggable loaded module. @plugins already
- # contains whatever M::P found on disk. The user might load a
- # plugin manually from some arbitrary namespace and ask for it to
- # be registered.
- if ( not any { $_ eq $plugin } @plugins ) {
- push @plugins, $plugin;
- }
-
- return;
-}
-
-1;
+++ /dev/null
-#!./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' );
-}
https://perl5.git.perl.org / perl5.git / commitdiff