Login
Added test for legit-but-falsely-identified-as-bad form of bless, with a fat comma
[gknop/Perl-Critic.git] / t / 20_policies_classhierarchies.t
1 ##################################################################
2 #      $URL$
3 #     $Date$
4 #   $Author$
5 # $Revision$
6 ##################################################################
7
8 use strict;
9 use warnings;
10 use Test::More tests => 7;
11 use Perl::Critic::Config;
12 use Perl::Critic;
13
14 # common P::C testing tools
15 use lib qw(t/tlib);
16 use PerlCriticTestUtils qw(pcritique);
17 PerlCriticTestUtils::block_perlcriticrc();
18
19 my $code ;
20 my $policy;
21 my %config;
22
23 #-----------------------------------------------------------------------------
24
25 $code = <<'END_PERL';
26 my $self = bless {};
27 my $self = bless [];
28
29 #Critic doesn't catch these,
30 #cuz they parse funny
31 #my $self = bless( {} );
32 #my $self = bless( [] );
33
34 END_PERL
35
36 $policy = 'ClassHierarchies::ProhibitOneArgBless';
37 is( pcritique($policy, \$code), 2, $policy );
38
39 #-----------------------------------------------------------------------------
40
41 $code = <<'END_PERL';
42 my $self = bless {}, 'foo';
43 my $self = bless( {}, 'foo' );
44 my $self = bless [], 'foo';
45 my $self = bless( [], 'foo' );
46 my $self = bless {} => 'foo';
47 END_PERL
48
49 $policy = 'ClassHierarchies::ProhibitOneArgBless';
50 is( pcritique($policy, \$code), 0, $policy );
51
52 #-----------------------------------------------------------------------------
53
54 $code = <<'END_PERL';
55 our @ISA = qw(Foo);
56 push @ISA, 'Foo';
57 @ISA = ('Foo');
58 END_PERL
59
60 $policy = 'ClassHierarchies::ProhibitExplicitISA';
61 is( pcritique($policy, \$code), 3, $policy );
62
63 #-----------------------------------------------------------------------------
64
65 $code = <<'END_PERL';
66 print @Foo::ISA;
67 use base 'Foo';
68 END_PERL
69
70 $policy = 'ClassHierarchies::ProhibitExplicitISA';
71 is( pcritique($policy, \$code), 0, $policy );
72
73 #-----------------------------------------------------------------------------
74
75 $code = <<'END_PERL';
76 sub AUTOLOAD {}
77 END_PERL
78
79 $policy = 'ClassHierarchies::ProhibitAutoloading';
80 is( pcritique($policy, \$code), 1, $policy );
81
82 #-----------------------------------------------------------------------------
83
84 $code = <<'END_PERL';
85 sub AUTOLOAD {
86      $foo, $bar = @_;
87      return $baz;
88 }
89 END_PERL
90
91 $policy = 'ClassHierarchies::ProhibitAutoloading';
92 is( pcritique($policy, \$code), 1, $policy );
93
94 #-----------------------------------------------------------------------------
95
96 $code = <<'END_PERL';
97 sub autoload {}
98 my $AUTOLOAD = 'foo';
99 our @AUTOLOAD = qw(nuts);
100 END_PERL
101
102 $policy = 'ClassHierarchies::ProhibitAutoloading';
103 is( pcritique($policy, \$code), 0, $policy );