view release on metacpan or  search on metacpan

t/code_smells.t  view on Meta::CPAN

#!/usr/bin/perl

use strict;
use warnings;

use Test::Most tests => 28;
use Class::Sniff;

{

    package Abstract;

    sub new {
        my ( $class, $arg_for ) = @_;
        #
        # Forcing this to be a long method to force a 'long method' report
        #
        #
        #
        #
        #
        #
        my $self = bless {} => $class;
        return $self;
    }

    sub foo { }
    sub bar { }
    sub baz { }

    package Child1;
    our @ISA = 'Abstract';
    use Carp 'croak';
    sub foo { 1 }

    package Child2;
    our @ISA = 'Abstract';
    sub foo { 1 }
    sub bar { }

    package Grandchild;
    our @ISA = qw<Child1 Child2>;
    sub foo  { }    # diamond inheritance
    sub bar  { }    # Not a problem because it's inherited through 1 path
    sub quux { }    # no inheritance
}

can_ok 'Class::Sniff', 'new';
my $sniff = Class::Sniff->new( { class => 'Grandchild', method_length => 10 } );
can_ok $sniff, 'report';
ok my $report = $sniff->report, '... and it should return a report of potential issues';

like $report, qr/Report for class: Grandchild/,
    'The report should have a title';

my $bar = qr/[^|]*\|[^|]*/;
my $bar_newline = qr/$bar \| \s* $bar/x;
like $report, qr/Overridden Methods/,
    'The report should identify overridden methods';
like $report, qr/bar $bar Grandchild $bar_newline Abstract $bar_newline Child2 /,
    '... identifying the method and the class(es) it is overridden in';

like $report, qr/Unreachable Methods/,
    'The report should identify unreachable methods';
like $report, qr/bar $bar Child2/,
    '... identifying the method and the class(es) it is unreachable in';

like $report, qr/Multiple Inheritance/,
    'The report should identify multiple inheritance';
like $report, qr/Grandchild $bar Child1 $bar_newline Child2 /x,
    '... identifying all parent classes';

like $report, qr/Exported Subroutines/,
    'The report should identify exported subroutines';
like $report,
  qr/Child1 $bar croak $bar Carp $bar_newline/x,
  '... and not miss any';

like $report, qr/Duplicate Methods/,
    'The report should identify duplicate methods';
like $report,
    qr/Grandchild::quux     $bar Abstract::bar
                 $bar_newline Abstract::baz