t/20_policies.t

   1 #!perl
   2
   3 ##############################################################################
   4 #      $URL: http://perlcritic.tigris.org/svn/perlcritic/branches/jeff/Perl-Critic-Dynamic/lib/Perl/Critic/Policy/Dynamic/ValidateAgainstSymbolTable.pm $
   5 #     $Date: 2007-06-07 05:40:51 -0700 (Thu, 07 Jun 2007) $
   6 #   $Author: thaljef $
   7 # $Revision: 1617 $
   8 ##############################################################################
   9
  10 use strict;
  11 use warnings;
  12 use Test::More;
  13 use English qw(-no_match_vars);
  14
  15 # common P::C testing tools
  16 use Perl::Critic::TestUtils qw(subtests_in_tree pcritique);
  17 Perl::Critic::TestUtils::block_perlcriticrc();
  18
  19 #-----------------------------------------------------------------------------
  20
  21 my $subtests = subtests_in_tree( 't' );
  22
  23 # Check for cmdline limit on policies.  Example:
  24 #   perl -Ilib t/20_policies.t BuiltinFunctions::ProhibitLvalueSubstr
  25 if (@ARGV) {
  26     my @policies = keys %{$subtests};
  27     # This is inefficient, but who cares...
  28     for my $p (@policies) {
  29         if (0 == grep {$_ eq $p} @ARGV) {
  30             delete $subtests->{$p};
  31         }
  32     }
  33 }
  34
  35 #-----------------------------------------------------------------------------
  36
  37 # count how many tests there will be
  38 my $nsubtests = 0;
  39 for my $s (values %$subtests) {
  40     $nsubtests += @$s; # one [pf]critique() test per subtest
  41 }
  42 my $npolicies = scalar keys %$subtests; # one can() test per policy
  43
  44 plan tests => $nsubtests + $npolicies;
  45
  46 #-----------------------------------------------------------------------------
  47
  48 for my $policy ( sort keys %$subtests ) {
  49
  50     can_ok( "Perl::Critic::Policy::$policy", 'violates' );
  51
  52     for my $subtest ( @{$subtests->{$policy}} ) {
  53
  54         local $TODO = $subtest->{TODO}; # Is NOT a TODO if it's not set
  55         my ($line, $test_name) = ($subtest->{lineno}, $subtest->{name});
  56         my $desc = join(' - ', $policy, "line $line", $test_name);
  57
  58         my $number_of_violations =
  59           eval { pcritique($policy, \$subtest->{code}, $subtest->{parms}) };
  60
  61         if ($subtest->{error}) {
  62             if ( 'Regexp' eq ref $subtest->{error} ) {
  63                 like($EVAL_ERROR, $subtest->{error}, $desc);
  64             }
  65             else {
  66                 ok($EVAL_ERROR, $desc);
  67             }
  68         }
  69         else {
  70             die $EVAL_ERROR if $EVAL_ERROR;
  71             is($number_of_violations, $subtest->{failures}, $desc);
  72         }
  73     }
  74 }
  75
  76 ##############################################################################
  77 # Local Variables:
  78 #   mode: cperl
  79 #   cperl-indent-level: 4
  80 #   fill-column: 78
  81 #   indent-tabs-mode: nil
  82 #   c-indentation-style: bsd
  83 # End:
  84 # ex: set ts=8 sts=4 sw=4 tw=78 expandtab ft=perl:
  85