git.maemo.org Git - pkg-perl/blob - deb-src/libperl-critic-perl/libperl-critic-perl-1.088/t/09_theme.t

   1 #!perl
   2
   3 ##############################################################################
   4 #      $URL: http://perlcritic.tigris.org/svn/perlcritic/trunk/Perl-Critic/t/09_theme.t $
   5 #     $Date: 2008-06-06 00:48:04 -0500 (Fri, 06 Jun 2008) $
   6 #   $Author: clonezone $
   7 # $Revision: 2416 $
   8 ##############################################################################
   9
  10 use 5.006001;
  11 use strict;
  12 use warnings;
  13 use English qw(-no_match_vars);
  14
  15 use List::MoreUtils qw(any all none);
  16 use Test::More (tests => 66);
  17
  18 use Perl::Critic::TestUtils;
  19 use Perl::Critic::PolicyFactory;
  20 use Perl::Critic::UserProfile;
  21 use Perl::Critic::Theme;
  22
  23 #-----------------------------------------------------------------------------
  24
  25 ILLEGAL_RULES:{
  26
  27     my @invalid_rules = (
  28         '$cosmetic',
  29         '"cosmetic"',
  30         '#cosmetic > bugs',
  31         'cosmetic / bugs',
  32         'cosmetic % bugs',
  33         'cosmetic + [bugs - pbp]',
  34         'cosmetic + {bugs - pbp}',
  35         'cosmetic @ bugs ^ pbp',
  36     );
  37
  38     for my $invalid ( @invalid_rules ) {
  39         eval { Perl::Critic::Theme::->new( -rule => $invalid ) };
  40         like( $EVAL_ERROR, qr/invalid character/, qq{Invalid rule: "$invalid"});
  41     }
  42 }
  43
  44 #-----------------------------------------------------------------------------
  45
  46 VALID_RULES:{
  47
  48     my @valid_rules = (
  49         'cosmetic',
  50         '!cosmetic',
  51         '-cosmetic',
  52         'not cosmetic',
  53
  54         'cosmetic + bugs',
  55         'cosmetic - bugs',
  56         'cosmetic + (bugs - pbp)',
  57         'cosmetic+(bugs-pbp)',
  58
  59         'cosmetic || bugs',
  60         'cosmetic && bugs',
  61         'cosmetic || (bugs - pbp)',
  62         'cosmetic||(bugs-pbp)',
  63
  64         'cosmetic or bugs',
  65         'cosmetic and bugs',
  66         'cosmetic or (bugs not pbp)',
  67     );
  68
  69     for my $valid ( @valid_rules ) {
  70         my $theme = Perl::Critic::Theme->new( -rule => $valid );
  71         ok( $theme, qq{Valid expression: "$valid"} );
  72     }
  73 }
  74
  75 #-----------------------------------------------------------------------------
  76
  77 TRANSLATIONS:
  78 {
  79     my %expressions = (
  80         'cosmetic'                     =>  'cosmetic',
  81         '!cosmetic'                    =>  '!cosmetic',
  82         '-cosmetic'                    =>  '!cosmetic',
  83         'not cosmetic'                 =>  '! cosmetic',
  84         'cosmetic + bugs',             =>  'cosmetic || bugs',
  85         'cosmetic - bugs',             =>  'cosmetic && ! bugs',
  86         'cosmetic + (bugs - pbp)'      =>  'cosmetic || (bugs && ! pbp)',
  87         'cosmetic+(bugs-pbp)'          =>  'cosmetic||(bugs&& !pbp)',
  88         'cosmetic or bugs'             =>  'cosmetic || bugs',
  89         'cosmetic and bugs'            =>  'cosmetic && bugs',
  90         'cosmetic and (bugs or pbp)'   =>  'cosmetic && (bugs || pbp)',
  91         'cosmetic + bugs'              =>  'cosmetic || bugs',
  92         'cosmetic * bugs'              =>  'cosmetic && bugs',
  93         'cosmetic * (bugs + pbp)'      =>  'cosmetic && (bugs || pbp)',
  94         'cosmetic || bugs',            =>  'cosmetic || bugs',
  95         '!cosmetic && bugs',           =>  '!cosmetic && bugs',
  96         'cosmetic && not (bugs or pbp)'=>  'cosmetic && ! (bugs || pbp)'
  97     );
  98
  99     while ( my ($raw, $expected) = each %expressions ) {
 100         my $cooked = Perl::Critic::Theme::cook_rule( $raw );
 101         is( $cooked, $expected, qq{Theme cooking: '$raw' -> '$cooked'});
 102     }
 103 }
 104
 105
 106 #-----------------------------------------------------------------------------
 107
 108 Perl::Critic::TestUtils::block_perlcriticrc();
 109
 110 {
 111     my $profile = Perl::Critic::UserProfile->new( -profile => q{} );
 112     my $factory = Perl::Critic::PolicyFactory->new( -profile => $profile );
 113     my @policy_names = Perl::Critic::PolicyFactory::site_policy_names();
 114     my @pols = map { $factory->create_policy( -name => $_ ) } @policy_names;
 115
 116     #--------------
 117
 118     my $rule = 'cosmetic';
 119     my $theme = Perl::Critic::Theme->new( -rule => $rule );
 120     my @members = grep { $theme->policy_is_thematic( -policy => $_) }  @pols;
 121     ok( all { has_theme( $_, 'cosmetic' ) } @members );
 122
 123     #--------------
 124
 125     $rule = 'cosmetic - pbp';
 126     $theme = Perl::Critic::Theme->new( -rule => $rule );
 127     @members = grep { $theme->policy_is_thematic( -policy => $_) }  @pols;
 128     ok( all  { has_theme( $_, 'cosmetic' ) } @members );
 129     ok( none { has_theme( $_, 'pbp')       } @members );
 130
 131     $rule = 'cosmetic and not pbp';
 132     $theme = Perl::Critic::Theme->new( -rule => $rule );
 133     @members = grep { $theme->policy_is_thematic( -policy => $_) }  @pols;
 134     ok( all  { has_theme( $_, 'cosmetic' ) } @members );
 135     ok( none { has_theme( $_, 'pbp')       } @members );
 136
 137     $rule = 'cosmetic && ! pbp';
 138     $theme = Perl::Critic::Theme->new( -rule => $rule );
 139     @members = grep { $theme->policy_is_thematic( -policy => $_) }  @pols;
 140     ok( all  { has_theme( $_, 'cosmetic' ) } @members );
 141     ok( none { has_theme( $_, 'pbp')       } @members );
 142
 143     #--------------
 144
 145     $rule = 'cosmetic + pbp';
 146     $theme = Perl::Critic::Theme->new( -rule => $rule );
 147     @members = grep { $theme->policy_is_thematic( -policy => $_) } @pols;
 148     ok( all  { has_theme($_, 'cosmetic') ||
 149                has_theme($_, 'pbp') } @members );
 150
 151     $rule = 'cosmetic || pbp';
 152     $theme = Perl::Critic::Theme->new( -rule => $rule );
 153     @members = grep { $theme->policy_is_thematic( -policy => $_) } @pols;
 154     ok( all  { has_theme($_, 'cosmetic') ||
 155                has_theme($_, 'pbp') } @members );
 156
 157     $rule = 'cosmetic or pbp';
 158     $theme = Perl::Critic::Theme->new( -rule => $rule );
 159     @members = grep { $theme->policy_is_thematic( -policy => $_) } @pols;
 160     ok( all  { has_theme($_, 'cosmetic') ||
 161                has_theme($_, 'pbp') } @members );
 162
 163     #--------------
 164
 165     $rule = 'bugs * pbp';
 166     $theme = Perl::Critic::Theme->new( -rule => $rule );
 167     @members = grep { $theme->policy_is_thematic( -policy => $_) } @pols;
 168     ok( all  { has_theme($_, 'bugs')  } @members );
 169     ok( all  { has_theme($_, 'pbp')   } @members );
 170
 171     $rule = 'bugs and pbp';
 172     $theme = Perl::Critic::Theme->new( -rule => $rule );
 173     @members = grep { $theme->policy_is_thematic( -policy => $_) } @pols;
 174     ok( all  { has_theme($_, 'bugs')  } @members );
 175     ok( all  { has_theme($_, 'pbp')   } @members );
 176
 177     $rule = 'bugs && pbp';
 178     $theme = Perl::Critic::Theme->new( -rule => $rule );
 179     @members = grep { $theme->policy_is_thematic( -policy => $_) } @pols;
 180     ok( all  { has_theme($_, 'bugs')  } @members );
 181     ok( all  { has_theme($_, 'pbp')   } @members );
 182
 183     #-------------
 184
 185     $rule = 'pbp - (danger * security)';
 186     $theme = Perl::Critic::Theme->new( -rule => $rule );
 187     @members = grep { $theme->policy_is_thematic( -policy => $_) } @pols;
 188     ok( all  { has_theme($_, 'pbp') } @members );
 189     ok( none { has_theme($_, 'danger') &&
 190                has_theme($_, 'security') } @members );
 191
 192     $rule = 'pbp and ! (danger and security)';
 193     $theme = Perl::Critic::Theme->new( -rule => $rule );
 194     @members = grep { $theme->policy_is_thematic( -policy => $_) } @pols;
 195     ok( all  { has_theme($_, 'pbp') } @members );
 196     ok( none { has_theme($_, 'danger') &&
 197                has_theme($_, 'security') } @members );
 198
 199     $rule = 'pbp && not (danger && security)';
 200     $theme = Perl::Critic::Theme->new( -rule => $rule );
 201     @members = grep { $theme->policy_is_thematic( -policy => $_) } @pols;
 202     ok( all  { has_theme($_, 'pbp') } @members );
 203     ok( none { has_theme($_, 'danger') &&
 204                has_theme($_, 'security') } @members );
 205
 206     #--------------
 207
 208     $rule = 'bogus';
 209     $theme =  Perl::Critic::Theme->new( -rule => $rule );
 210     @members = grep { $theme->policy_is_thematic( -policy => $_) } @pols;
 211     is( scalar @members, 0, 'bogus theme' );
 212
 213     $rule = 'bogus - pbp';
 214     $theme =  Perl::Critic::Theme->new( -rule => $rule );
 215     @members = grep { $theme->policy_is_thematic( -policy => $_) } @pols;
 216     is( scalar @members, 0, 'bogus theme' );
 217
 218     $rule = q{};
 219     $theme =  Perl::Critic::Theme->new( -rule => $rule );
 220     @members = grep { $theme->policy_is_thematic( -policy => $_) } @pols;
 221     is( scalar @members, scalar @pols, 'empty theme' );
 222
 223     $rule = q{};
 224     $theme =  Perl::Critic::Theme->new( -rule => $rule );
 225     @members = grep { $theme->policy_is_thematic( -policy => $_) } @pols;
 226     is( scalar @members, scalar @pols, 'undef theme' );
 227
 228     #--------------
 229     # Exceptions
 230
 231     $rule = 'cosmetic *(';
 232     $theme =  Perl::Critic::Theme->new( -rule => $rule );
 233     eval{ $theme->policy_is_thematic( -policy => $pols[0] ) };
 234     like( $EVAL_ERROR, qr/syntax error/, 'invalid theme expression' );
 235
 236 }
 237
 238 #-----------------------------------------------------------------------------
 239
 240 sub has_theme {
 241     my ($policy, $theme) = @_;
 242     return any { $_ eq $theme } $policy->get_themes();
 243 }
 244
 245 #-----------------------------------------------------------------------------
 246
 247 # ensure we run true if this test is loaded by
 248 # t/09_theme.t_without_optional_dependencies.t
 249 1;
 250
 251 ##############################################################################
 252 # Local Variables:
 253 #   mode: cperl
 254 #   cperl-indent-level: 4
 255 #   fill-column: 78
 256 #   indent-tabs-mode: nil
 257 #   c-indentation-style: bsd
 258 # End:
 259 # ex: set ts=8 sts=4 sw=4 tw=78 ft=perl expandtab shiftround :