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

   1 #!perl
   2
   3 ##############################################################################
   4 #     $URL: http://perlcritic.tigris.org/svn/perlcritic/trunk/Perl-Critic/t/11_policyfactory.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 use Test::More (tests => 10);
  15 use Perl::Critic::UserProfile;
  16 use Perl::Critic::PolicyFactory (-test => 1);
  17
  18 # common P::C testing tools
  19 use Perl::Critic::TestUtils qw();
  20 Perl::Critic::TestUtils::block_perlcriticrc();
  21
  22 #-----------------------------------------------------------------------------
  23
  24 {
  25     my $policy_name = 'Perl::Critic::Policy::Modules::ProhibitEvilModules';
  26     my $params = {severity => 2, set_themes => 'betty', add_themes => 'wilma'};
  27
  28     my $userprof = Perl::Critic::UserProfile->new( -profile => 'NONE' );
  29     my $pf = Perl::Critic::PolicyFactory->new( -profile  => $userprof );
  30
  31
  32     # Now test...
  33     my $policy = $pf->create_policy( -name => $policy_name, -params => $params );
  34     is( ref $policy, $policy_name, 'Created correct type of policy');
  35
  36     my $severity = $policy->get_severity();
  37     is( $severity, 2, 'Set the severity');
  38
  39     my @themes = $policy->get_themes();
  40     is_deeply( \@themes, [ qw(betty wilma) ], 'Set the theme');
  41 }
  42
  43 #-----------------------------------------------------------------------------
  44 # Using short module name.
  45 {
  46     my $policy_name = 'Variables::ProhibitPunctuationVars';
  47     my $params = {set_themes => 'betty', add_themes => 'wilma'};
  48
  49     my $userprof = Perl::Critic::UserProfile->new( -profile => 'NONE' );
  50     my $pf = Perl::Critic::PolicyFactory->new( -profile  => $userprof );
  51
  52
  53     # Now test...
  54     my $policy = $pf->create_policy( -name => $policy_name, -params => $params );
  55     my $policy_name_long = 'Perl::Critic::Policy::' . $policy_name;
  56     is( ref $policy, $policy_name_long, 'Created correct type of policy');
  57
  58     my @themes = $policy->get_themes();
  59     is_deeply( \@themes, [ qw(betty wilma) ], 'Set the theme');
  60 }
  61
  62 #-----------------------------------------------------------------------------
  63 # Test exception handling
  64
  65 {
  66     my $userprof = Perl::Critic::UserProfile->new( -profile => 'NONE' );
  67     my $pf = Perl::Critic::PolicyFactory->new( -profile  => $userprof );
  68
  69     # Try missing arguments
  70     eval{ $pf->create_policy() };
  71     like( $EVAL_ERROR, qr/The -name argument/m, 'create without -name arg' );
  72
  73     # Try creating bogus policy
  74     eval{ $pf->create_policy( -name => 'Perl::Critic::Foo' ) };
  75     like( $EVAL_ERROR, qr/Can't locate object method/m, 'create bogus policy' );
  76
  77     # Try using a bogus severity level
  78     my $policy_name = 'Modules::RequireVersionVar';
  79     my $policy_params = {severity => 'bogus'};
  80     eval{ $pf->create_policy( -name => $policy_name, -params => $policy_params)};
  81     like( $EVAL_ERROR, qr/Invalid severity: "bogus"/m, 'create policy w/ bogus severity' );
  82 }
  83
  84 #-----------------------------------------------------------------------------
  85 # Test warnings about bogus policies
  86
  87 {
  88     my $last_warning = q{}; #Trap warning messages here
  89     local $SIG{__WARN__} = sub { $last_warning = shift };
  90
  91     my $profile = { 'Perl::Critic::Bogus' => {} };
  92     my $userprof = Perl::Critic::UserProfile->new( -profile => $profile );
  93     my $pf = Perl::Critic::PolicyFactory->new( -profile  => $userprof );
  94     like( $last_warning, qr/^Policy ".*Bogus" is not installed/m );
  95     $last_warning = q{};
  96
  97     $profile = { '-Perl::Critic::Shizzle' => {} };
  98     $userprof = Perl::Critic::UserProfile->new( -profile => $profile );
  99     $pf = Perl::Critic::PolicyFactory->new( -profile  => $userprof );
 100     like( $last_warning, qr/^Policy ".*Shizzle" is not installed/m );
 101     $last_warning = q{};
 102 }
 103
 104 #-----------------------------------------------------------------------------
 105
 106 # ensure we run true if this test is loaded by
 107 # t/11_policyfactory.t_without_optional_dependencies.t
 108 1;
 109
 110 ##############################################################################
 111 # Local Variables:
 112 #   mode: cperl
 113 #   cperl-indent-level: 4
 114 #   fill-column: 78
 115 #   indent-tabs-mode: nil
 116 #   c-indentation-style: bsd
 117 # End:
 118 # ex: set ts=8 sts=4 sw=4 tw=78 ft=perl expandtab shiftround :