view release on metacpan or  search on metacpan

lib/Perl/Lint/Policy/ControlStructures/ProhibitLabelsWithSpecialBlockNames.pm  view on Meta::CPAN

package Perl::Lint::Policy::ControlStructures::ProhibitLabelsWithSpecialBlockNames;
use strict;
use warnings;
use Perl::Lint::Constants::Type;
use parent "Perl::Lint::Policy";

use constant {
    DESC => 'Special block name used as label',
    EXPL => 'Use a label that cannot be confused with BEGIN, END, CHECK, INIT, or UNITCHECK blocks',
};

sub evaluate {
    my ($class, $file, $tokens, $src, $args) = @_;

    my @violations;
    for (my $i = 0; my $token = $tokens->[$i]; $i++) {
        my $token_type = $token->{type};

        if ($token_type == MOD_WORD) {

t/Policy/ControlStructures/prohibit_labels_with_special_block_names.t  view on Meta::CPAN

===
--- dscr: Basic passing
--- failures: 0
--- params:
--- input
BEGIN       { $x = 1; }
END         { $x = 1; }
CHECK       { $x = 1; }
INIT        { $x = 1; }
UNITCHECK   { $x = 1; }

===
--- dscr: Failure, cuddled colon
--- failures: 5
--- params:
--- input
BEGIN:      { $x = 1; }
END:        { $x = 1; }
CHECK:      { $x = 1; }
INIT:       { $x = 1; }
UNITCHECK:  { $x = 1; }

===
--- dscr: Failure, uncuddled colon
--- failures: 5
--- params:
--- input
BEGIN :     { $x = 1; }
END :       { $x = 1; }
CHECK :     { $x = 1; }
INIT :      { $x = 1; }
UNITCHECK : { $x = 1; }

===
--- dscr: no lint
--- failures: 4
--- params:
--- input
BEGIN:      { $x = 1; }
END:        { $x = 1; }
CHECK:      { $x = 1; } ## no lint
INIT:       { $x = 1; }
UNITCHECK:  { $x = 1; }

t/Policy/Subroutines/prohibit_nested_subs.t  view on Meta::CPAN

}

===
--- dscr: Scheduled blocks inside subroutine declarations.
--- failures: 0
--- params:
--- input
sub quack {
    state $foo;

    UNITCHECK {
        $foo = 1;
    }
}

===
--- dscr: Subroutine declarations inside scheduled blocks inside subroutine declarations.
--- failures: 1
--- params:
--- input
sub quack {